Fix integration tests (#1200)

Fixes #1199
insightsengineering · Mar 8, 2024 · c819776 · c819776
1 parent 9a3ac37
commit c819776
Show file tree

Hide file tree

Showing 5 changed files with 159 additions and 112 deletions.
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
@@ -28,7 +28,10 @@ expect_snapshot_ggplot <- function(title, fig, width = NA, height = NA) {
 
   name <- paste0(title, ".svg")
   path <- tempdir()
-  suppressMessages(ggplot2::ggsave(name, fig, path = path, width = width, height = height))
+  withr::with_options(
+    opts_partial_match_old,
+    suppressMessages(ggplot2::ggsave(name, fig, path = path, width = width, height = height))
+  )
   path <- file.path(path, name)
 
   testthat::announce_snapshot_file(name = name)

diff --git a/tests/testthat/test-decorate_grob.R b/tests/testthat/test-decorate_grob.R
@@ -61,34 +61,37 @@ testthat::test_that("decorate_grob_factory returns page warning correctly", {
 })
 
 testthat::test_that("decorate_grob_set returns no warnings when creating a non-empty plot", {
-  g <- with(data = iris, {
-    list(
-      ggplot2::ggplotGrob(
-        ggplot2::ggplot(mapping = aes(Sepal.Length, Sepal.Width, col = Species)) +
-          ggplot2::geom_point()
-      ),
-      ggplot2::ggplotGrob(
-        ggplot2::ggplot(mapping = aes(Sepal.Length, Petal.Length, col = Species)) +
-          ggplot2::geom_point()
-      ),
-      ggplot2::ggplotGrob(
-        ggplot2::ggplot(mapping = aes(Sepal.Length, Petal.Width, col = Species)) +
-          ggplot2::geom_point()
-      ),
-      ggplot2::ggplotGrob(
-        ggplot2::ggplot(mapping = aes(Sepal.Width, Petal.Length, col = Species)) +
-          ggplot2::geom_point()
-      ),
-      ggplot2::ggplotGrob(
-        ggplot2::ggplot(mapping = aes(Sepal.Width, Petal.Width, col = Species)) +
-          ggplot2::geom_point()
-      ),
-      ggplot2::ggplotGrob(
-        ggplot2::ggplot(mapping = aes(Petal.Length, Petal.Width, col = Species)) +
-          ggplot2::geom_point()
+  g <- withr::with_options(
+    opts_partial_match_old,
+    with(data = iris, {
+      list(
+        ggplot2::ggplotGrob(
+          ggplot2::ggplot(mapping = aes(Sepal.Length, Sepal.Width, col = Species)) +
+            ggplot2::geom_point()
+        ),
+        ggplot2::ggplotGrob(
+          ggplot2::ggplot(mapping = aes(Sepal.Length, Petal.Length, col = Species)) +
+            ggplot2::geom_point()
+        ),
+        ggplot2::ggplotGrob(
+          ggplot2::ggplot(mapping = aes(Sepal.Length, Petal.Width, col = Species)) +
+            ggplot2::geom_point()
+        ),
+        ggplot2::ggplotGrob(
+          ggplot2::ggplot(mapping = aes(Sepal.Width, Petal.Length, col = Species)) +
+            ggplot2::geom_point()
+        ),
+        ggplot2::ggplotGrob(
+          ggplot2::ggplot(mapping = aes(Sepal.Width, Petal.Width, col = Species)) +
+            ggplot2::geom_point()
+        ),
+        ggplot2::ggplotGrob(
+          ggplot2::ggplot(mapping = aes(Petal.Length, Petal.Width, col = Species)) +
+            ggplot2::geom_point()
+        )
       )
-    )
-  })
+    })
+  )
   lg <- testthat::expect_silent(
     decorate_grob_set(grobs = g, titles = "Hello\nOne\nTwo\nThree", footnotes = "")
   )

diff --git a/tests/testthat/test-g_km.R b/tests/testthat/test-g_km.R
@@ -8,10 +8,13 @@ testthat::test_that("g_km default plot works", {
 
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  grob_tmp <- g_km(
-    df = df,
-    variables = variables,
-    ci_ribbon = FALSE
+  withr::with_options(
+    opts_partial_match_old,
+    grob_tmp <- g_km(
+      df = df,
+      variables = variables,
+      ci_ribbon = FALSE
+    )
   )
 
   vdiffr::expect_doppelganger(title = "grob_tmp", fig = grob_tmp)
@@ -27,10 +30,13 @@ testthat::test_that("g_km default plot witch ci_ribbon = TRUE works", {
 
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  grob_tmp_ci <- g_km(
-    df = df,
-    variables = variables,
-    ci_ribbon = TRUE
+  grob_tmp_ci <- withr::with_options(
+    opts_partial_match_old,
+    g_km(
+      df = df,
+      variables = variables,
+      ci_ribbon = TRUE
+    )
   )
 
   vdiffr::expect_doppelganger(title = "grob_tmp_ci", fig = grob_tmp_ci)
@@ -50,11 +56,16 @@ testthat::test_that("g_km plot with < = > in group labels works", {
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "group")
 
   # snapshot test fails in integration tests
-  testthat::expect_silent(g_km(
-    df = df,
-    variables = variables,
-    annot_surv_med = FALSE
-  ))
+  testthat::expect_silent(
+    withr::with_options(
+      opts_partial_match_old,
+      g_km(
+        df = df,
+        variables = variables,
+        annot_surv_med = FALSE
+      )
+    )
+  )
 })
 
 testthat::test_that("g_km ylim parameter works as expected", {
@@ -68,31 +79,40 @@ testthat::test_that("g_km ylim parameter works as expected", {
 
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  g_km_crop_ylim <- g_km(
-    df = df,
-    variables = variables,
-    annot_surv_med = FALSE,
-    annot_at_risk = FALSE,
-    max_time = 1000
+  g_km_crop_ylim <- withr::with_options(
+    opts_partial_match_old,
+    g_km(
+      df = df,
+      variables = variables,
+      annot_surv_med = FALSE,
+      annot_at_risk = FALSE,
+      max_time = 1000
+    )
   )
   vdiffr::expect_doppelganger(title = "g_km_crop_ylim", fig = g_km_crop_ylim)
 
-  g_km_crop_ylim_failure <- g_km(
-    df = df,
-    variables = variables,
-    yval = "Failure",
-    annot_surv_med = FALSE,
-    annot_at_risk = FALSE,
-    max_time = 1000
+  g_km_crop_ylim_failure <- withr::with_options(
+    opts_partial_match_old,
+    g_km(
+      df = df,
+      variables = variables,
+      yval = "Failure",
+      annot_surv_med = FALSE,
+      annot_at_risk = FALSE,
+      max_time = 1000
+    )
   )
   vdiffr::expect_doppelganger(title = "g_km_crop_ylim_failure", fig = g_km_crop_ylim_failure)
 
-  g_km_custom_ylim <- g_km(
-    df = df,
-    variables = variables,
-    annot_surv_med = FALSE,
-    annot_at_risk = FALSE,
-    ylim = c(0.25, 0.75)
+  g_km_custom_ylim <- withr::with_options(
+    opts_partial_match_old,
+    g_km(
+      df = df,
+      variables = variables,
+      annot_surv_med = FALSE,
+      annot_at_risk = FALSE,
+      ylim = c(0.25, 0.75)
+    )
   )
   vdiffr::expect_doppelganger(title = "g_km_custom_ylim", fig = g_km_custom_ylim)
 })
@@ -108,10 +128,13 @@ testthat::test_that("annot_at_risk_title parameter works as expected", {
 
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  g_km_at_risk_title <- g_km(
-    df = df,
-    variables = variables,
-    annot_at_risk_title = TRUE
+  g_km_at_risk_title <- withr::with_options(
+    opts_partial_match_old,
+    g_km(
+      df = df,
+      variables = variables,
+      annot_at_risk_title = TRUE
+    )
   )
   vdiffr::expect_doppelganger(title = "g_km_at_risk_title", fig = g_km_at_risk_title)
 })
@@ -127,12 +150,15 @@ testthat::test_that("ref_group_coxph parameter works as expected", {
 
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  g_km_ref_group_coxph <- g_km(
-    df = df,
-    variables = variables,
-    annot_coxph = TRUE,
-    ref_group_coxph = "ARM B",
-    annot_coxph_ref_lbls = TRUE
+  g_km_ref_group_coxph <- withr::with_options(
+    opts_partial_match_old,
+    g_km(
+      df = df,
+      variables = variables,
+      annot_coxph = TRUE,
+      ref_group_coxph = "ARM B",
+      annot_coxph_ref_lbls = TRUE
+    )
   )
   vdiffr::expect_doppelganger(title = "g_km_ref_group_coxph", fig = g_km_ref_group_coxph)
 })
diff --git a/tests/testthat/test-g_lineplot.R b/tests/testthat/test-g_lineplot.R
@@ -14,18 +14,21 @@ testthat::test_that("g_lineplot works with default settings", {
 testthat::test_that("g_lineplot works with custom settings and statistics table", {
   testthat::skip_if_not_installed("vdiffr")
 
-  g_lineplot_w_stats <- g_lineplot(
-    adlb,
-    adsl,
-    group_var = control_lineplot_vars(group_var = NULL),
-    mid = "median",
-    table = c("n", "mean", "mean_ci"),
-    control = control_analyze_vars(conf_level = 0.80),
-    title = "Plot of Mean and 80% Confidence Limits by Visit",
-    x_lab = "Time",
-    y_lab = "Lab Test",
-    subtitle = "Laboratory Test:",
-    caption = "caption"
+  g_lineplot_w_stats <- withr::with_options(
+    opts_partial_match_old,
+    g_lineplot(
+      adlb,
+      adsl,
+      group_var = control_lineplot_vars(group_var = NULL),
+      mid = "median",
+      table = c("n", "mean", "mean_ci"),
+      control = control_analyze_vars(conf_level = 0.80),
+      title = "Plot of Mean and 80% Confidence Limits by Visit",
+      x_lab = "Time",
+      y_lab = "Lab Test",
+      subtitle = "Laboratory Test:",
+      caption = "caption"
+    )
   )
 
   expect_snapshot_ggplot(title = "g_lineplot_w_stats", fig = g_lineplot_w_stats, width = 10, height = 8)
@@ -34,17 +37,20 @@ testthat::test_that("g_lineplot works with custom settings and statistics table"
 testthat::test_that("g_lineplot works with cohort_id specified", {
   testthat::skip_if_not_installed("vdiffr")
 
-  g_lineplot_cohorts <- g_lineplot(
-    adlb,
-    adsl,
-    group_var = control_lineplot_vars(group_var = "ARM", subject_var = "USUBJID"),
-    mid = "median",
-    table = c("n", "mean", "mean_ci"),
-    control = control_analyze_vars(conf_level = 0.80),
-    title = "Plot of Mean and 80% Confidence Limits by Visit",
-    y_lab = "Lab Test",
-    subtitle = "Laboratory Test:",
-    caption = "caption"
+  g_lineplot_cohorts <- withr::with_options(
+    opts_partial_match_old,
+    g_lineplot(
+      adlb,
+      adsl,
+      group_var = control_lineplot_vars(group_var = "ARM", subject_var = "USUBJID"),
+      mid = "median",
+      table = c("n", "mean", "mean_ci"),
+      control = control_analyze_vars(conf_level = 0.80),
+      title = "Plot of Mean and 80% Confidence Limits by Visit",
+      y_lab = "Lab Test",
+      subtitle = "Laboratory Test:",
+      caption = "caption"
+    )
   )
   expect_snapshot_ggplot(title = "g_lineplot_cohorts", fig = g_lineplot_cohorts, width = 10, height = 8)
 })
diff --git a/tests/testthat/test-kaplan_meier_plot.R b/tests/testthat/test-kaplan_meier_plot.R
@@ -148,8 +148,11 @@ testthat::test_that("g_km works with default settings", {
     mutate(is_event = CNSR == 0)
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  testthat::expect_silent(
-    g_km(df = df, variables = variables)
+  withr::with_options(
+    opts_partial_match_old,
+    testthat::expect_silent(
+      g_km(df = df, variables = variables)
+    )
   )
 })
 
@@ -159,13 +162,16 @@ testthat::test_that("g_km works with title/footnotes and annotation", {
     mutate(is_event = CNSR == 0)
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  testthat::expect_silent(
-    g_km(
-      df = df,
-      variables = variables,
-      title = "KM Plot",
-      footnotes = "footnotes",
-      annot_coxph = TRUE
+  withr::with_options(
+    opts_partial_match_old,
+    testthat::expect_silent(
+      g_km(
+        df = df,
+        variables = variables,
+        title = "KM Plot",
+        footnotes = "footnotes",
+        annot_coxph = TRUE
+      )
     )
   )
 })
@@ -176,16 +182,19 @@ testthat::test_that("g_km works with custom settings", {
     mutate(is_event = CNSR == 0)
   variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD")
 
-  testthat::expect_silent(
-    g_km(
-      df = df,
-      variables = variables,
-      yval = "Failure",
-      annot_at_risk = FALSE,
-      annot_surv_med = FALSE,
-      lty = 1,
-      xticks = 500,
-      max_time = NULL
+  withr::with_options(
+    opts_partial_match_old,
+    testthat::expect_silent(
+      g_km(
+        df = df,
+        variables = variables,
+        yval = "Failure",
+        annot_at_risk = FALSE,
+        annot_surv_med = FALSE,
+        lty = 1,
+        xticks = 500,
+        max_time = NULL
+      )
     )
   )
 })