Fix setting seed in build_reference() (#2355)

And test that it works

DESCRIPTION

@@ -55,6 +55,7 @@ Suggests:
     rsconnect,
     rstudioapi,
     rticles,
+    rvest,
     sass,
     testthat (>= 3.1.3),
     tools

NEWS.md

@@ -11,6 +11,7 @@
 * Add Catalan translation (@jmaspons, #2333)
 * Set RNG seed for htmlwidgets IDs. This reduces noise in pkgdown reference HTML output when examples generate htmlwidgets (@salim-b, #2294).
 * Fix BS5 navbar template to get `navbar.type: dark` to work with bslib 0.6+ / Bootstrap 5.3+ (@tanho63, #2388)
+* Fix setting `seed` in `build_reference()`. The seed was reset too early, before. (@salim-b, #2355)
 * Translates citation sections (@eliocamp, #2410).
 * Topic names that conflict with selector functions can now be listed as references in `_pkgdown.yml` (@dmurdoch, #2397).
 

R/build-reference.R

@@ -227,7 +227,7 @@ examples_env <- function(pkg, seed = 1014, devel = TRUE, envir = parent.frame())
   withr::local_dir(path(pkg$dst_path, "reference"), .local_envir = envir)
   width <- purrr::pluck(pkg, "meta", "code", "width", .default = 80)
   withr::local_options(width = width, .local_envir = envir)
-  withr::local_seed(seed)
+  withr::local_seed(seed, .local_envir = envir)
   if (requireNamespace("htmlwidgets", quietly = TRUE)) {
     htmlwidgets::setWidgetIdSeed(seed)
   }

tests/testthat/_snaps/build-reference.md

@@ -44,3 +44,11 @@
       Reading man/a.Rd
       Writing reference/a.html
 
+# examples are reproducible by default, i.e. 'seed' is respected
+
+    Code
+      cat(examples)
+    Output
+      testpackage:::f()
+      #> [1] 0.080750138 0.834333037 0.600760886 0.157208442 0.007399441
+

tests/testthat/assets/reference/DESCRIPTION

@@ -3,4 +3,4 @@ Version: 1.0.0
 Title: A test package
 Description: A test package
 Authors@R: person("Hadley Wickham")
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.3

tests/testthat/assets/reference/R/funs.R

@@ -21,3 +21,9 @@ c <- function() {}
 #' E
 #' @name e
 NULL
+
+#' F
+#' @keywords internal
+#' @examples
+#' testpackage:::f()
+f <- function() {runif(5L)}

tests/testthat/test-build-reference.R

@@ -94,6 +94,19 @@ test_that("pkgdown html dependencies are suppressed from examples in references"
   expect_length(bs_css_href, 1)
 })
 
+test_that("examples are reproducible by default, i.e. 'seed' is respected", {
+  pkg <- local_pkgdown_site(test_path("assets/reference"))
+  suppressMessages(build_reference(pkg, topics = "f"))
+
+  examples <- xml2::read_html(file.path(pkg$dst_path, "reference", "f.html")) %>%
+    rvest::html_node("div#ref-examples div.sourceCode") %>%
+    rvest::html_text() %>%
+    # replace line feeds with whitespace to make output platform independent
+    gsub("\r", "", .)
+
+  expect_snapshot(cat(examples))
+})
+
 test_that("get_rdname handles edge cases", {
   expect_equal(get_rdname(list(file_in = "foo..Rd")), "foo.")
   expect_equal(get_rdname(list(file_in = "foo.rd")), "foo")