From 63b9efd5d33aeb58f3f22aa990c3ebe1cbc6ac43 Mon Sep 17 00:00:00 2001
From: Carson <cpsievert1@gmail.com>
Date: Wed, 17 Mar 2021 14:12:52 -0500
Subject: [PATCH] Skip snapshots on R < 3.6

---
 tests/testthat/helper.R        | 11 -----------
 tests/testthat/test-tabPanel.R | 27 ++++++++++++++++++---------
 2 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
index 71ac518845..c0444e6e63 100644
--- a/tests/testthat/helper.R
+++ b/tests/testthat/helper.R
@@ -83,14 +83,3 @@ rewire_namespace_handler <- function(pkgname, symbolname, value) {
     }
   }
 }
-
-
-# R3.6 changed the RNGkind() default. This restores the old default
-# before calling set.seed() so we can have consistent random results
-# across R versions.
-with_private_seed <- function(x) {
-  kind <- RNGkind()
-  on.exit(do.call(RNGkind, as.list(kind)), add = TRUE)
-  suppressWarnings(RNGversion("3.5.0"))
-  withPrivateSeed(x)
-}
diff --git a/tests/testthat/test-tabPanel.R b/tests/testthat/test-tabPanel.R
index 49a2037ea7..663d7ec932 100644
--- a/tests/testthat/test-tabPanel.R
+++ b/tests/testthat/test-tabPanel.R
@@ -1,20 +1,28 @@
 # tabsetPanel() et al. use p_randomInt() to generate ids (which uses withPrivateSeed()),
 # so we need to fix Shiny's private seed in order to make their HTML output deterministic
 navlist_panel <- function(...) {
-  with_private_seed(set.seed(100))
+
+  withPrivateSeed(set.seed(100))
   navlistPanel(...)
 }
 navbar_page <- function(...) {
-  with_private_seed(set.seed(100))
+  withPrivateSeed(set.seed(100))
   navbarPage(...)
 }
 tabset_panel <- function(...) {
-  with_private_seed(set.seed(100))
+  withPrivateSeed(set.seed(100))
   tabsetPanel(...)
 }
 
+expect_snapshot2 <- function(...) {
+  if (getRversion() < "3.6.0") {
+    skip("Skipping non-deterministic snapshots on R < 3.6")
+  }
+  expect_snapshot(...)
+}
+
 expect_snapshot_bslib <- function(x, ...) {
-  expect_snapshot(bslib_tags(x), ...)
+  expect_snapshot2(bslib_tags(x), ...)
 }
 
 # Simulates the UI tags that would be produced by
@@ -33,6 +41,7 @@ panels <- list(
 )
 
 test_that("tabsetPanel() markup is correct", {
+
   default <- tabset_panel(!!!panels)
   pills <- tabset_panel(
     !!!panels, type = "pills", selected = "B",
@@ -40,8 +49,8 @@ test_that("tabsetPanel() markup is correct", {
     footer = div(class = "content-footer")
   )
   # BS3
-  expect_snapshot(default)
-  expect_snapshot(pills)
+  expect_snapshot2(default)
+  expect_snapshot2(pills)
   # BS4
   expect_snapshot_bslib(default)
   expect_snapshot_bslib(pills)
@@ -51,14 +60,14 @@ test_that("tabsetPanel() markup is correct", {
 
 test_that("navbarPage() markup is correct", {
   nav_page <- navbar_page("Title", !!!panels)
-  expect_snapshot(nav_page)
+  expect_snapshot2(nav_page)
   expect_snapshot_bslib(nav_page)
 })
 
 # navlistPanel() can handle strings, but the others can't
 test_that("String input is handled properly", {
   nav_list <- navlist_panel(!!!c(list("A header"), panels))
-  expect_snapshot(nav_list)
+  expect_snapshot2(nav_list)
   expect_snapshot_bslib(nav_list)
   expect_error(
     tabsetPanel(!!!c(list("A header"), panels)),
@@ -73,7 +82,7 @@ test_that("Shiny.tag input produces a warning", {
   # sensible (which is why we now throw a warning), but it's probably
   # too late to change the behavior (it could break user code to do
   # anything different)
-  expect_snapshot(tab_tags)
+  expect_snapshot2(tab_tags)
 })
 
 test_that("tabPanelBody validates it's input", {