diff --git a/tests/testthat/helpers/expectors.R b/tests/testthat/helpers/expectors.R new file mode 100644 index 000000000..2b70b3302 --- /dev/null +++ b/tests/testthat/helpers/expectors.R @@ -0,0 +1,27 @@ +# A customized version of vdiffr::expect_doppelganger() that is needed because +# in 'testthat' versions >= 3.3.0, testthat::expect_snapshot_file() (upon which +# vdiffr::expect_doppelganger() builds) errors if the snapshot file name has +# already been used. +expect_doppelganger_cust <- function(title, + fig, + test_filename = "methods_vsel", + ...) { + snap_nm_old <- testthat::test_path( + "_snaps", test_filename, paste0(tolower(gsub("\\.|_", "-", title)), ".svg") + ) + if (packageVersion("testthat") >= "3.3.0" && file.exists(snap_nm_old)) { + variant_tmp <- paste0("tmp_doppelganger__", + format(Sys.time(), format = "%Y-%m-%d_%H-%M-%S")) + vdiffr::expect_doppelganger(title, fig, variant = variant_tmp, ...) + snap_nm_new <- sub("_snaps", file.path("_snaps", variant_tmp), snap_nm_old) + expect_true(compare_file_text(old = snap_nm_old, + new = snap_nm_new), + info = title) + file.remove(snap_nm_new) + file.remove(testthat::test_path("_snaps", variant_tmp, test_filename)) + file.remove(testthat::test_path("_snaps", variant_tmp)) + } else { + vdiffr::expect_doppelganger(title = title, fig = fig, ...) + } + return(invisible(TRUE)) +} diff --git a/tests/testthat/helpers/testers.R b/tests/testthat/helpers/testers.R index d2122c066..94592b1e7 100644 --- a/tests/testthat/helpers/testers.R +++ b/tests/testthat/helpers/testers.R @@ -2960,7 +2960,7 @@ plot_vsel_tester <- function( expect_identical(attr(plot_vsel, "projpred_ranking_abbreviated"), attr_abbv_expected, info = info_str) if (run_snaps) { - vdiffr::expect_doppelganger(info_str, plot_vsel) + expect_doppelganger_cust(info_str, plot_vsel) } return(invisible(TRUE)) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index a7c0fab94..7e32b2281 100755 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -164,6 +164,7 @@ source(testthat::test_path("helpers", "formul_handlers.R"), local = TRUE) source(testthat::test_path("helpers", "predictor_handlers.R"), local = TRUE) source(testthat::test_path("helpers", "dummies.R"), local = TRUE) source(testthat::test_path("helpers", "creators.R"), local = TRUE) +source(testthat::test_path("helpers", "expectors.R"), local = TRUE) # Note: The following `mod_nms` refer to *generalized* (linear/additive, # multilevel) models. This is due to history (when these tests were written, diff --git a/tests/testthat/test_methods_vsel.R b/tests/testthat/test_methods_vsel.R index 7921dba80..a7f12f14c 100644 --- a/tests/testthat/test_methods_vsel.R +++ b/tests/testthat/test_methods_vsel.R @@ -752,7 +752,7 @@ test_that("`x` of class `cv_proportions` works", { for (tstsetup in names(plotprs)) { expect_s3_class(plotprs[[tstsetup]], c("gg", "ggplot")) if (run_snaps) { - vdiffr::expect_doppelganger(tstsetup, plotprs[[tstsetup]]) + expect_doppelganger_cust(tstsetup, plotprs[[tstsetup]]) } } }) @@ -768,7 +768,7 @@ test_that("plot.ranking() is a shortcut", { )) expect_s3_class(plotpr_from_rk, c("gg", "ggplot")) if (run_snaps) { - vdiffr::expect_doppelganger(tstsetup, plotpr_from_rk) + expect_doppelganger_cust(tstsetup, plotpr_from_rk) } } })