Resolve warnings in unit tests

Boehringer-Ingelheim · Jul 26, 2024 · 55a13c4 · 55a13c4
1 parent 94ed6a2
commit 55a13c4
Show file tree

Hide file tree

Showing 2 changed files with 46 additions and 38 deletions.
diff --git a/R/server_functions_main_view.R b/R/server_functions_main_view.R
@@ -209,7 +209,7 @@ create_main_plot <- function(work_data,
   shapes <- dplyr::case_when(
     x == "decrease" ~ 25,
     x == "increase" ~ 24,
-    x == "start/equal" ~ 23,
+    x == "start/equal" ~ 23
   )
   names(shapes) <- x
   symbol_color <- colors[unique(work_data[!is.na(work_data$xmin_exp), ]$group)]
@@ -229,14 +229,18 @@ create_main_plot <- function(work_data,
       color = "black",
       position = ggplot2::position_nudge(y = 0.35),
       size = height / 20
-    ) +
-    ggplot2::scale_shape_manual(
-      name = "Dose Change:",
-      values = shapes,
-      na.translate = FALSE,
-      breaks = x
     )
 
+  if (length(shapes) > 0) {
+    main_p <- main_p +
+      ggplot2::scale_shape_manual(
+        name = "Dose Change:",
+        values = shapes,
+        na.translate = FALSE,
+        breaks = x
+      )
+  }
+
   # Add arrows for open intervals
   if (height >= 120) {
     main_p <- main_p +

diff --git a/tests/testthat/test-server_functions_main_view.R b/tests/testthat/test-server_functions_main_view.R
@@ -438,37 +438,41 @@ test_that(
   "create_main_plot() returns a plot that determines vertical space per subject according to user settings" %>%
     vdoc[["add_spec"]](specs$sidebar_specs$boxheight),
   {
-    shiny::testServer(
-      server_func,
-      args = list(
-        id = "main_view",
-        initial_data = shiny::reactive({
-          df
-        }),
-        changed = changed,
-        colors_group = shiny::reactive({
-          colors
-        })
-      ),
-      {
-        session$setInputs(
-          date_range = c("2012-08-15T00:00", "2015-01-01T01:00"),
-          day_range = c(0, 50),
-          x_scale = "date",
-          y_sort = "alphanum",
-          height = 30,
-          filter_event = c("Treatment Start", "Adverse Events")
-        )
-
-        session$flushReact()
-
-        expect_snapshot_output(plot_obj(), cran = TRUE)
-
-        session$setInputs(height = 130)
-        session$flushReact()
-
-        expect_snapshot_output(plot_obj(), cran = TRUE)
-      }
+    # Test produces warnings regarding conversion failure of the arrows for open intervals.
+    # Warnings are suppressed, since this does not impact the module usage within an app.
+    suppressWarnings(
+      shiny::testServer(
+        server_func,
+        args = list(
+          id = "main_view",
+          initial_data = shiny::reactive({
+            df
+          }),
+          changed = changed,
+          colors_group = shiny::reactive({
+            colors
+          })
+        ),
+        {
+          session$setInputs(
+            date_range = c("2012-08-15T00:00", "2015-01-01T01:00"),
+            day_range = c(0, 50),
+            x_scale = "date",
+            y_sort = "alphanum",
+            height = 30,
+            filter_event = c("Treatment Start", "Adverse Events")
+          )
+
+          session$flushReact()
+
+          expect_snapshot_output(plot_obj(), cran = TRUE)
+
+          session$setInputs(height = 130)
+          session$flushReact()
+
+          expect_snapshot_output(plot_obj(), cran = TRUE)
+        }
+      )
     )
   }
 )