Merge pull request #397 from stan-dev/testthat-3e

Testthat 3e

Author: jgabry

.Rbuildignore

@@ -14,5 +14,6 @@ images/*
 book/*
 docs/*
 Rplots.pdf
+.vscode/*
 ^\.github$
 ^release-prep\.R$

.gitignore

@@ -13,3 +13,6 @@ revdep/*
 CRAN-RELEASE
 CRAN-SUBMISSION
 release-prep.R
+
+# vscode/positron/etc settings
+.vscode/*

DESCRIPTION

@@ -56,9 +56,10 @@ Suggests:
     scales,
     shinystan (>= 2.3.0),
     survival,
-    testthat (>= 2.0.0),
+    testthat (>= 3.0.0),
     vdiffr (>= 1.0.2)
 RoxygenNote: 7.3.3
 VignetteBuilder: knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
+Config/testthat/edition: 3

tests/testthat/test-aesthetics.R

@@ -1,7 +1,3 @@
-library(bayesplot)
-context("Aesthetics")
-
-
 # color scheme stuff ------------------------------------------------------
 
 prepare_colors_for_test <- function(scheme) {
@@ -13,13 +9,13 @@ prepare_colors_for_test <- function(scheme) {
 
 test_that("getting and setting the color scheme works", {
   color_scheme_set("red")
-  expect_equivalent(color_scheme_get(), prepare_colors_for_test("red"))
+  expect_equal(color_scheme_get(), prepare_colors_for_test("red"), ignore_attr = TRUE)
   expect_named(prepare_colors_for_test("blue"), scheme_level_names())
   expect_named(color_scheme_get(), scheme_level_names())
   for (clr in names(master_color_list)) {
     color_scheme_set(clr)
-    expect_equivalent(color_scheme_get(), prepare_colors_for_test(clr),
-                      info = clr)
+    expect_equal(color_scheme_get(), prepare_colors_for_test(clr),
+                      info = clr, ignore_attr = TRUE)
     expect_named(color_scheme_get(), scheme_level_names())
   }
 
@@ -28,7 +24,7 @@ test_that("getting and setting the color scheme works", {
   expect_gg(plot(color_scheme_get("mix-blue-green")))
 
   color_scheme_set("blue")
-  expect_equivalent(color_scheme_get("teal"), prepare_colors_for_test("teal"))
+  expect_equal(color_scheme_get("teal"), prepare_colors_for_test("teal"), ignore_attr = TRUE)
 
   # error if not character
   expect_error(color_scheme_set(7), "'scheme' should be a character vector of length 1 or 6")
@@ -60,10 +56,10 @@ test_that("color_scheme_get with i argument works", {
 
 test_that("setting mixed scheme works", {
   color_scheme_set("mix-gray-blue")
-  expect_equivalent(color_scheme_get(), mixed_scheme("gray", "blue"))
+  expect_equal(color_scheme_get(), mixed_scheme("gray", "blue"), ignore_attr = TRUE)
 
   color_scheme_set("mix-blue-gray")
-  expect_equivalent(color_scheme_get(), mixed_scheme("blue", "gray"))
+  expect_equal(color_scheme_get(), mixed_scheme("blue", "gray"), ignore_attr = TRUE)
 
   expect_error(color_scheme_set("mix-green-reds"), "should be one of")
   expect_error(color_scheme_set("mix-greens-red"), "should be one of")
@@ -72,9 +68,9 @@ test_that("setting mixed scheme works", {
 test_that("setting brewer scheme works", {
   skip_if_not_installed("RColorBrewer")
   color_scheme_set("brewer-Blues")
-  expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Blues"))
+  expect_equal(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Blues"), ignore_attr = TRUE)
   color_scheme_set("brewer-Spectral")
-  expect_equivalent(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"))
+  expect_equal(unlist(color_scheme_get()), RColorBrewer::brewer.pal(6, "Spectral"), ignore_attr = TRUE)
   expect_error(color_scheme_set("brewer-FAKE"), "FAKE is not a valid palette")
 })
 
@@ -106,11 +102,11 @@ test_that("mixed_scheme internal function doesn't error", {
 test_that("custom color schemes work", {
   color_scheme_set(orange_scheme_ok)
   expect_named(color_scheme_get())
-  expect_equivalent(unlist(color_scheme_get()), orange_scheme_ok)
+  expect_equal(unlist(color_scheme_get()), orange_scheme_ok, ignore_attr = TRUE)
 
   random_scheme <- colors()[sample(length(colors()), 6)]
   color_scheme_set(random_scheme)
-  expect_equivalent(unlist(color_scheme_get()), random_scheme)
+  expect_equal(unlist(color_scheme_get()), random_scheme, ignore_attr = TRUE)
 })
 
 test_that("get_color returns correct color values", {

tests/testthat/test-available_ppc.R

@@ -1,7 +1,3 @@
-library(bayesplot)
-context("available_mcmc and available_ppc")
-
-
 test_that("available_mcmc works", {
   a <- available_mcmc()
   expect_s3_class(a, "bayesplot_function_list")

tests/testthat/test-bayesplot_grid.R

@@ -1,6 +1,3 @@
-library(bayesplot)
-context("bayesplot_grid")
-
 skip_if_not_installed("gridExtra")
 
 y <- example_y_data()

tests/testthat/test-convenience-functions.R

@@ -1,42 +1,39 @@
-library(bayesplot)
 library(ggplot2)
-context("Convenience functions (for ggplot objects)")
-
 
 # abline_01, vline_ and hline_ ------------------------------------------
 test_that("abline_01 returns the correct object", {
   a <- abline_01(color = "green", linetype = 2)
   b <- geom_abline(intercept = 0, slope = 1, color = "green", linetype = 2, na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 test_that("vline_* and hline_* return correct objects", {
   a <- vline_0(color = "red")
   b <- geom_vline(xintercept = 0, color = "red", na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 
   a <- hline_0(linewidth = 2, linetype = 3)
   b <- geom_hline(yintercept = 0, linewidth = 2, linetype = 3, na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 
   a <- vline_at(c(3,4), na.rm = FALSE)
   b <- geom_vline(xintercept = c(3,4))
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 
   a <- hline_at(c(3,4), na.rm = FALSE)
   b <- geom_hline(yintercept = c(3,4))
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 test_that("vline_at with 'fun' works", {
   x <- example_mcmc_draws(chains = 1)
   a <- vline_at(x, colMeans)
   b <- geom_vline(xintercept = colMeans(x), na.rm = TRUE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 test_that("calc_v (internal function) works", {
   a <- 1:4
@@ -99,20 +96,21 @@ test_that("facet_bg returns correct theme object", {
 test_that("legend_none returns correct theme object", {
   none <- legend_none()
   expect_s3_class(none, "theme")
-  expect_equivalent(none, list(legend.position = "none"))
+  expect_equal(none$legend.position, "none", ignore_attr = TRUE)
   expect_false(attr(none, "complete"))
 })
 test_that("legend_move returns correct theme object", {
   left <- legend_move("left")
   expect_s3_class(left, "theme")
-  expect_equivalent(left, list(legend.position = "left"))
+  expect_equal(left$legend.position, "left", ignore_attr = TRUE)
   expect_false(attr(left, "complete"))
 
   pos <- legend_move(c(0.25, 0.5))
   expect_s3_class(pos, "theme")
-  expect_equivalent(
+  expect_equal(
     pos$legend.position.inside %||% pos$legend.position,
-    c(0.25, 0.5)
+    c(0.25, 0.5),
+    ignore_attr = TRUE
   )
   expect_false(attr(pos, "complete"))
 })
@@ -133,9 +131,10 @@ test_that("xaxis_text returns correct theme object", {
 })
 test_that("yaxis_text returns correct theme object", {
   expect_identical(yaxis_text(FALSE), theme(axis.text.y = element_blank()))
-  expect_equivalent(
+  expect_equal(
     yaxis_text(face = "bold", angle = 30),
-    theme(axis.text.y = element_text(face = "bold", angle = 30))
+    theme(axis.text.y = element_text(face = "bold", angle = 30)),
+    ignore_attr = TRUE
   )
 })
 test_that("facet_text returns correct theme object", {
@@ -185,7 +184,7 @@ test_that("overlay_function returns the correct object", {
   a <- overlay_function(fun = "dnorm")
   b <- stat_function(fun = "dnorm", inherit.aes = FALSE)
   a$constructor <- b$constructor <- NULL
-  expect_equal(a, b, check.environment = FALSE)
+  expect_equal(a, b, ignore_function_env = TRUE)
 })
 
 

tests/testthat/test-example-draws.R

@@ -1,6 +1,3 @@
-library(bayesplot)
-context("Example draws")
-
 test_that("example_mcmc_draws throws correct errors", {
   expect_error(example_mcmc_draws(chains = 5), "chains <= 4")
   expect_error(example_mcmc_draws(chains = 0), "chains >= 1")
@@ -26,7 +23,7 @@ test_that("example ppc data works", {
 
   yrep <- example_yrep_draws()
   expect_type(yrep, "double")
-  expect_is(yrep, "matrix")
+  expect_true(is.matrix(yrep))
   expect_equal(ncol(yrep), length(y))
 
   group <- example_group_data()

tests/testthat/test-extractors.R

@@ -1,6 +1,3 @@
-library(bayesplot)
-context("Extractors")
-
 if (requireNamespace("rstanarm", quietly = TRUE)) {
   ITER <- 1000
   CHAINS <- 3
@@ -84,7 +81,7 @@ test_that("neff_ratio.stanreg returns correct structure", {
   ratio <- neff_ratio(fit)
   expect_named(ratio)
   ans <- summary(fit)[1:length(ratio), "n_eff"] / (floor(ITER / 2) * CHAINS)
-  expect_equal(ratio, ans, tol = 0.001)
+  expect_equal(ratio, ans, tolerance = 0.001)
 })
 
 test_that("rhat.stanfit returns correct structure", {
@@ -107,12 +104,12 @@ test_that("neff_ratio.stanreg returns correct structure", {
   ratio <- neff_ratio(fit$stanfit)
   expect_named(ratio)
   ans <- summary(fit)[, "n_eff"] / denom
-  expect_equal(ratio, ans, tol = 0.001)
+  expect_equal(ratio, ans, tolerance = 0.001)
 
   ratio2 <- neff_ratio(fit$stanfit, pars = c("wt", "sigma"))
   expect_named(ratio2)
   ans2 <- summary(fit, pars = c("wt", "sigma"))[, "n_eff"] / denom
-  expect_equal(ratio2, ans2, tol = 0.001)
+  expect_equal(ratio2, ans2, tolerance = 0.001)
 })
 
 test_that("cmdstanr methods work", {

tests/testthat/test-helpers-mcmc.R

@@ -1,10 +1,5 @@
-library(bayesplot)
-context("MCMC: misc. functions")
-
 source(test_path("data-for-mcmc-tests.R"))
 
-
-
 # melt_mcmc ----------------------------------------------------------------
 test_that("melt_mcmc does not convert integer parameter names to integers #162", {
   mat2 <- mat[, 1:2]
@@ -303,7 +298,11 @@ test_that("diagnostic_factor.rhat works", {
                       high = 1.2, high = 1.7))
 
   r <- diagnostic_factor(unname(rhats))
-  expect_equivalent(r, as.factor(names(rhats)))
+  expect_equal(
+    r,
+    factor(names(rhats), levels = c("low", "ok", "high")),
+    ignore_attr = TRUE
+  )
   expect_identical(levels(r), c("low", "ok", "high"))
 })
 test_that("diagnostic_factor.neff_ratio works", {
@@ -312,7 +311,11 @@ test_that("diagnostic_factor.neff_ratio works", {
                              high = 0.51, high = 0.99, high = 1))
 
   r <- diagnostic_factor(unname(ratios))
-  expect_equivalent(r, as.factor(names(ratios)))
+  expect_equal(
+    r,
+    factor(names(ratios), levels = c("low", "ok", "high")),
+    ignore_attr = TRUE
+  )
   expect_identical(levels(r), c("low", "ok", "high"))
 })