tests: reflect new block element with title

Author: averissimo

tests/testthat/helper-Reporter.R

@@ -29,22 +29,27 @@ test_card2.ReportCard <- local({ # nolint: object_name.
   }
 })
 
-test_card1 <- function() {
+test_card1 <- function(title = NULL) {
   withr::with_environment(emptyenv(), plot <- ggplot2::ggplot(iris, ggplot2::aes(x = Petal.Length)) +
     ggplot2::geom_histogram(binwidth = 0.2))
-  doc("## Header 2 text", "A paragraph of default text", plot)
+  new_card <- doc("## Header 2 text", "A paragraph of default text", plot)
+  if (!is.null(title)) metadata(new_card, "title") <- title
+  new_card
 }
 
 test_card2 <- local({
-  fun <- function() {
+  fun <- function(title = NULL) {
     lyt <- rtables::analyze(rtables::split_rows_by(rtables::basic_table(), "Day"), "Ozone", afun = mean)
     table_res2 <- rtables::build_table(lyt, within(airquality, Day <- factor(Day))) # nolint: object_name.
-    doc("## Header 2 text", "A paragraph of default text", table_res2, iris)
+    new_card <- doc("## Header 2 text", "A paragraph of default text", table_res2, iris)
+    if (!is.null(title)) metadata(new_card, "title") <- title
+    new_card
   }
-  cache <- NULL
-  function() {
-    if (is.null(cache)) cache <<- fun()
-    cache
+  cache <- list()
+  function(title = NULL) {
+    title_ix <- title %||% "no_title"
+    if (is.null(cache[[title_ix]])) cache[[title_ix]] <<- fun(title)
+    cache[[title_ix]]
   }
 })
 

tests/testthat/test-Reporter.R

@@ -58,15 +58,27 @@ testthat::test_that("get_cards returns the same cards which was added to reporte
 })
 
 testthat::test_that("get_blocks returns the same blocks which was added to reporter, sep = NULL", {
-  reporter <- test_reporter(card1 <- test_card1(), card2 <- test_card2())
-  testthat::expect_identical(reporter$get_blocks(sep = NULL), append(unclass(card1), unclass(card2)))
+  reporter <- test_reporter(card1 <- test_card1("A title"), card2 <- test_card2("Another title"))
+  testthat::expect_identical(
+    reporter$get_blocks(sep = NULL),
+    append(
+      c(sprintf("# %s", metadata(card1, "title")), card1),
+      c(sprintf("# %s", metadata(card2, "title")), card2)
+    )
+  )
 })
 
 testthat::test_that("get_blocks by default adds NewpageBlock$new() between cards", {
-  reporter <- test_reporter(card1 <- test_card1(), card2 <- test_card2())
+  card1 <- test_card1("A title")
+  card2 <- test_card2("Another title")
+  reporter <- test_reporter(card1, card2)
+
+  reporter_1 <- Reporter$new()$append_cards(card1)
+  reporter_2 <- Reporter$new()$append_cards(card2)
+
   reporter_blocks <- reporter$get_blocks()
-  reporter_blocks2 <- append(reporter_blocks[1:3], "\\newpage")
-  reporter_blocks2 <- append(reporter_blocks2, reporter_blocks[5:8])
+  reporter_blocks2 <- append(reporter_1$get_blocks(), "\\newpage")
+  reporter_blocks2 <- append(reporter_blocks2, reporter_2$get_blocks())
   testthat::expect_equal(reporter$get_blocks(), reporter_blocks2)
 })