Use testthat 3e (#4522)

Author: yutannihilation

DESCRIPTION

@@ -64,7 +64,7 @@ Suggests:
     rpart,
     sf (>= 0.7-3),
     svglite (>= 1.2.0.9001),
-    testthat (>= 2.1.0),
+    testthat (>= 3.0.0),
     vdiffr (>= 1.0.0),
     xml2
 Enhances: sp
@@ -274,3 +274,4 @@ Config/Needs/website:
     tidyr,
     forcats,
     tidyverse/tidytemplate
+Config/testthat/edition: 3

tests/testthat/test-add.R

@@ -1,5 +1,3 @@
-context("Adding plot elements")
-
 test_that("mapping class is preserved when adding uneval objects", {
   p <- ggplot(mtcars) + aes(wt, mpg)
   expect_identical(class(p$mapping), "uneval")

tests/testthat/test-aes-calculated.r

@@ -1,5 +1,3 @@
-context("test-aes-calculated.r")
-
 test_that("constants aren't calculated", {
   expect_equal(is_calculated_aes(aes(1, "a", TRUE)), c(FALSE, FALSE, FALSE))
 })

tests/testthat/test-aes-grouping.r

@@ -1,5 +1,3 @@
-context("Aesthetics (grouping)")
-
 df <- data_frame(
   x = 1:4,
   a = c("a", "a", "b", "b"),

tests/testthat/test-aes-setting.r

@@ -1,5 +1,3 @@
-context("Aes - setting values")
-
 test_that("aesthetic parameters match length of data", {
   df <- data_frame(x = 1:5, y = 1:5)
   p <- ggplot(df, aes(x, y))

tests/testthat/test-aes.r

@@ -1,5 +1,3 @@
-context("Creating aesthetic mappings")
-
 test_that("aes() captures input expressions", {
   out <- aes(mpg, wt + 1)
   expect_identical(out$x, quo(mpg))
@@ -36,7 +34,9 @@ test_that("aes_q() & aes_string() preserve explicit NULLs", {
 test_that("aes_all() converts strings into mappings", {
   expect_equal(
     aes_all(c("x", "y", "col", "pch")),
-    aes(x, y, colour = col, shape = pch)
+    aes(x, y, colour = col, shape = pch),
+    # ignore the environments of quosures
+    ignore_attr = TRUE
   )
 })
 

tests/testthat/test-annotate.r

@@ -1,5 +1,3 @@
-context("annotate")
-
 test_that("dates in segment annotation work", {
   dt <- structure(list(month = structure(c(1364774400, 1377993600),
       class = c("POSIXct", "POSIXt"), tzone = "UTC"), total = c(-10.3,

tests/testthat/test-build.r

@@ -1,6 +1,4 @@
 # Test the complete path from plot specification to rendered data
-context("Plot building")
-
 df <- data_frame(x = 1:3, y = 3:1, z = letters[1:3])
 
 test_that("there is one data frame for each layer", {
@@ -19,8 +17,8 @@ test_that("position aesthetics are coerced to correct type", {
   l1 <- ggplot(df, aes(x, y)) + geom_point()
   d1 <- layer_data(l1, 1)
 
-  expect_is(d1$x, "numeric")
-  expect_is(d1$y, "numeric")
+  expect_type(d1$x, "double")
+  expect_type(d1$y, "double")
 
   l2 <- ggplot(df, aes(x, z)) + geom_point() + scale_x_discrete()
   d2 <- layer_data(l2, 1)
@@ -52,5 +50,5 @@ test_that("strings are not converted to factors", {
   p <- ggplot(df, aes(x, y)) +
     geom_text(aes(label = label), parse = TRUE)
 
-  expect_is(layer_data(p)$label, "character")
+  expect_type(layer_data(p)$label, "character")
 })

tests/testthat/test-coord-.r

@@ -1,5 +1,3 @@
-context("test-coord-.r")
-
 test_that("clipping is on by default", {
   p <- ggplot()
   coord <- ggplot_build(p)$layout$coord

tests/testthat/test-coord-cartesian.R

@@ -1,5 +1,3 @@
-context("coord_cartesian")
-
 test_that("clipping can be turned off and on", {
   # clip on by default
   p <- ggplot() + coord_cartesian()

tests/testthat/test-coord-flip.R

@@ -1,5 +1,3 @@
-context("test-coord-flip.r")
-
 test_that("secondary labels are correctly turned off", {
   # Using a visual test because the labels are only generated during rendering
   expect_doppelganger("turning off secondary title with coord_flip",

tests/testthat/test-coord-map.R

@@ -1,5 +1,3 @@
-context("coord_map")
-
 test_that("USA state map drawn", {
   skip_if(packageVersion("base") < "3.5.0")
   us_map <- map_data("usa")

tests/testthat/test-coord-polar.r

@@ -1,5 +1,3 @@
-context("coord_polar")
-
 test_that("polar distance is calculated correctly", {
   dat <- data_frame(
     theta = c(0, 2*pi,   2,   6, 6, 1,    1,  0),

tests/testthat/test-coord-train.r

@@ -1,5 +1,3 @@
-context("coord_train")
-
 test_that("NA's don't appear in breaks", {
 
   # Returns true if any major/minor breaks have an NA

tests/testthat/test-coord-transform.R

@@ -1,5 +1,3 @@
-context("coord_trans")
-
 test_that("warnings are generated when cord_trans() results in new infinite values", {
   p  <- ggplot(head(diamonds, 20)) +
     geom_bar(aes(x = cut)) +
@@ -9,8 +7,12 @@ test_that("warnings are generated when cord_trans() results in new infinite valu
     geom_point() +
     coord_trans(x = "log")
 
-  expect_warning(ggplot_gtable(ggplot_build(p)), "Transformation introduced infinite values in y-axis")
-  expect_warning(ggplot_gtable(ggplot_build(p2)), "Transformation introduced infinite values in x-axis")
+  # TODO: These multiple warnings should be summarized nicely. Until this gets
+  #       fixed, this test ignores all the following errors than the first one.
+  suppressWarnings({
+    expect_warning(ggplot_gtable(ggplot_build(p)), "Transformation introduced infinite values in y-axis")
+    expect_warning(ggplot_gtable(ggplot_build(p2)), "Transformation introduced infinite values in x-axis")
+  })
 })
 
 test_that("no warnings are generated when original data has Inf values, but no new Inf values created from the transformation", {

tests/testthat/test-coord_sf.R

@@ -1,5 +1,3 @@
-context("coord_sf")
-
 test_that("basic plot builds without error", {
   skip_if_not_installed("sf")
 

tests/testthat/test-data.r

@@ -1,25 +1,25 @@
-context("Data")
-
 test_that("stringsAsFactors doesn't affect results", {
-    old <- getOption("stringsAsFactors")
-    on.exit(options(stringsAsFactors = old), add = TRUE)
+  skip_if(as.integer(R.Version()$major) >= 4L, "stringsAsFactors only affects R <4.0")
+
+  old <- getOption("stringsAsFactors")
+  on.exit(options(stringsAsFactors = old), add = TRUE)
 
-    dat.character <- data_frame(x = letters[5:1], y = 1:5)
-    dat.factor <- data_frame(x = letters[5:1], y = 1:5)
+  dat.character <- data_frame(x = letters[5:1], y = 1:5)
+  dat.factor <- data_frame(x = letters[5:1], y = 1:5)
 
-    base <- ggplot(mapping = aes(x, y)) + geom_point()
-    xlabels <- function(x) x$layout$panel_params[[1]]$x$get_labels()
+  base <- ggplot(mapping = aes(x, y)) + geom_point()
+  xlabels <- function(x) x$layout$panel_params[[1]]$x$get_labels()
 
-    options(stringsAsFactors = TRUE)
-    char_true <- ggplot_build(base %+% dat.character)
-    factor_true <- ggplot_build(base %+% dat.factor)
+  options(stringsAsFactors = TRUE)
+  char_true <- ggplot_build(base %+% dat.character)
+  factor_true <- ggplot_build(base %+% dat.factor)
 
-    options(stringsAsFactors = FALSE)
-    char_false <- ggplot_build(base %+% dat.character)
-    factor_false <- ggplot_build(base %+% dat.factor)
+  options(stringsAsFactors = FALSE)
+  char_false <- ggplot_build(base %+% dat.character)
+  factor_false <- ggplot_build(base %+% dat.factor)
 
-    expect_equal(xlabels(char_true), letters[1:5])
-    expect_equal(xlabels(char_false), letters[1:5])
-    expect_equal(xlabels(factor_true), letters[1:5])
-    expect_equal(xlabels(factor_false), letters[1:5])
+  expect_equal(xlabels(char_true), letters[1:5])
+  expect_equal(xlabels(char_false), letters[1:5])
+  expect_equal(xlabels(factor_true), letters[1:5])
+  expect_equal(xlabels(factor_false), letters[1:5])
 })

tests/testthat/test-draw-key.R

@@ -1,6 +1,4 @@
 # Setting of legend key glyphs has to be tested visually
-context("Legend key glyphs")
-
 
 test_that("alternative key glyphs work", {
   df <- data_frame(x = 1:3, y = 3:1, z = letters[1:3])

tests/testthat/test-empty-data.r

@@ -1,5 +1,3 @@
-context('Empty data')
-
 df0 <- data_frame(mpg = numeric(0), wt = numeric(0), am = numeric(0), cyl = numeric(0))
 
 test_that("layers with empty data are silently omitted", {

tests/testthat/test-error.R

@@ -1,5 +1,3 @@
-context("error")
-
 test_that("various misuses of +.gg (#2638)", {
   expect_error(
     {

tests/testthat/test-facet-.r

@@ -1,5 +1,3 @@
-context("Facetting")
-
 test_that("as_facets_list() coerces formulas", {
   expect_identical(as_facets_list(~foo), list(quos(), quos(foo = foo)))
   expect_identical(as_facets_list(~foo + bar), list(quos(), quos(foo = foo, bar = bar)))
@@ -277,15 +275,16 @@ test_that("combine_vars() generates the correct combinations", {
     factor = factor(c("level1", "level2")),
     stringsAsFactors = FALSE
   )
+  attr(df_all, "out.attrs") <- NULL
 
   vars_all <- vars(letter = letter, number =  number, boolean = boolean, factor = factor)
 
-  expect_equivalent(
+  expect_equal(
     combine_vars(list(df_one), vars = vars_all),
     df_one
   )
 
-  expect_equivalent(
+  expect_equal(
     combine_vars(list(df_all), vars = vars_all),
     df_all
   )
@@ -295,21 +294,22 @@ test_that("combine_vars() generates the correct combinations", {
   # NAs are kept with with drop = TRUE
   # drop keeps all combinations of data, regardless of the combinations in which
   # they appear in the data (in addition to keeping unused factor levels)
-  expect_equivalent(
+  expect_equal(
     combine_vars(list(df_one), vars = vars_all, drop = FALSE),
-    df_all[order(df_all$letter, df_all$number, df_all$boolean, df_all$factor), ]
+    df_all[order(df_all$letter, df_all$number, df_all$boolean, df_all$factor), ],
+    ignore_attr = TRUE   # do not compare `row.names`
   )
 })
 
 test_that("drop = FALSE in combine_vars() keeps unused factor levels", {
   df <- data_frame(x = factor("a", levels = c("a", "b")))
-  expect_equivalent(
+  expect_equal(
     combine_vars(list(df), vars = vars(x = x), drop = TRUE),
-    data_frame(x = factor("a"))
+    data_frame(x = factor("a", levels = c("a", "b")))
   )
-  expect_equivalent(
+  expect_equal(
     combine_vars(list(df), vars = vars(x = x), drop = FALSE),
-    data_frame(x = factor(c("a", "b")))
+    data_frame(x = factor(c("a", "b"), levels = c("a", "b")))
   )
 })
 

tests/testthat/test-facet-labels.r

@@ -1,5 +1,3 @@
-context("Facet Labels")
-
 get_labels_matrix <- function(plot, ...) {
   data <- ggplot_build(plot)
   layout <- data$layout

tests/testthat/test-facet-layout.r

@@ -1,5 +1,3 @@
-context("Facetting (layout)")
-
 a <- data_frame(a = c(1, 1, 2, 2), b = c(1, 2, 1, 1))
 b <- data_frame(a = 3)
 c <- data_frame(b = 3)

tests/testthat/test-facet-map.r

@@ -1,5 +1,3 @@
-context("Facetting (mapping)")
-
 df <- expand.grid(a = 1:2, b = 1:2)
 df_a <- unique(df["a"])
 df_b <- unique(df["b"])

tests/testthat/test-facet-strips.r

@@ -1,5 +1,3 @@
-context("Facet Strips")
-
 strip_layout <- function(p) {
   data <- ggplot_build(p)
   plot <- data$plot

tests/testthat/test-fortify.r

@@ -1,5 +1,3 @@
-context("Fortify")
-
 test_that("spatial polygons have correct ordering", {
   skip_if_not_installed("sp")
 
@@ -31,9 +29,17 @@ test_that("spatial polygons have correct ordering", {
   polys2 <- rev(polys)
   polys2_sp <- sp::SpatialPolygons(polys2)
   fake_sp2 <- sp::SpatialPolygonsDataFrame(polys2_sp, fake_data)
-  fake_sp2_fortified <- fortify(fake_sp2)
+  expected <- fortify(fake_sp2)
+  expected <- expected[order(expected$id, expected$order), ]
+
+  actual <- fortify(fake_sp)
+
+  # the levels are different, so these columns need to be converted to character to compare
+  expected$group <- as.character(expected$group)
+  actual$group <- as.character(actual$group)
 
-  expect_equivalent(fortify(fake_sp), fake_sp2_fortified[order(fake_sp2_fortified$id, fake_sp2_fortified$order), ])
+  # Use expect_equal(ignore_attr = TRUE) to ignore rownames
+  expect_equal(actual, expected, ignore_attr = TRUE)
 })
 
 test_that("fortify.default proves a helpful error with class uneval", {

tests/testthat/test-function-args.r

@@ -1,5 +1,3 @@
-context("function-args")
-
 filter_args <- function(x) {
   all_names <- names(x)
   all_names <- setdiff(all_names, c("self", "data", "scales", "coordinates", "..."))

tests/testthat/test-geom-bar.R

@@ -1,5 +1,3 @@
-context("geom_bar")
-
 test_that("geom_bar removes bars with parts outside the plot limits", {
   dat <- data_frame(x = c("a", "b", "b", "c", "c", "c"))
 

tests/testthat/test-geom-boxplot.R

@@ -1,5 +1,3 @@
-context("geom_boxplot")
-
 # thanks wch for providing the test code
 test_that("geom_boxplot range includes all outliers", {
   dat <- data_frame(x = 1, y = c(-(1:20) ^ 3, (1:20) ^ 3) )

tests/testthat/test-geom-col.R

@@ -1,5 +1,3 @@
-context("geom_col")
-
 test_that("geom_col removes columns with parts outside the plot limits", {
   dat <- data_frame(x = c(1, 2, 3))
 

tests/testthat/test-geom-dotplot.R

@@ -1,5 +1,3 @@
-context("geom_dotplot")
-
 skip_on_cran() # This test suite is long-running (on cran) and is skipped
 
 set.seed(111)

tests/testthat/test-geom-freqpoly.R

@@ -1,5 +1,3 @@
-context("geom_freqpoly")
-
 test_that("can do frequency polygon with categorical x", {
   df <- data_frame(x = rep(letters[1:3], 3:1))
 

tests/testthat/test-geom-hex.R

@@ -1,5 +1,3 @@
-context("geom_hex")
-
 test_that("density and value summaries are available", {
   df <- data_frame(x = c(1, 1, 1, 2), y = c(1, 1, 1, 2))
   base <- ggplot(df, aes(x, y)) +

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

@@ -1,5 +1,3 @@
-context("geom-hline-vline-abline")
-
 
 # Visual tests ------------------------------------------------------------
 

tests/testthat/test-geom-path.R

@@ -1,5 +1,3 @@
-context("geom-path")
-
 test_that("keep_mid_true drops leading/trailing FALSE", {
   expect_equal(keep_mid_true(c(F, F)), c(F, F))
   expect_equal(keep_mid_true(c(F, T, F, T, F)), c(F, T, T, T, F))

tests/testthat/test-geom-point.R

@@ -1,5 +1,3 @@
-context("geom-point")
-
 test_that("single strings translate to their corresponding integers", {
   expect_equal(translate_shape_string("square open"), 0)
 })

tests/testthat/test-geom-polygon.R

@@ -1,5 +1,3 @@
-context("geom-polygon")
-
 
 # Visual tests ------------------------------------------------------------