Adds necessary shinytest2 helpers for automated tests

.github/workflows/check.yaml

@@ -28,6 +28,7 @@ jobs:
       additional-env-vars: |
         _R_CHECK_CRAN_INCOMING_REMOTE_=false
         _R_CHECK_EXAMPLE_TIMING_THRESHOLD_=11
+        TESTING_DEPTH=5
       additional-r-cmd-check-params: --as-cran
       enforce-note-blocklist: true
       note-blocklist: |

DESCRIPTION

@@ -70,6 +70,7 @@ Suggests:
     nestcolor (>= 0.1.0),
     rlang (>= 1.0.0),
     rtables (>= 0.6.6),
+    shinytest2,
     sparkline,
     testthat (>= 3.0.4),
     withr (>= 2.0.0)
@@ -89,7 +90,8 @@ Config/Needs/verdepcheck: haleyjeppson/ggmosaic, tidyverse/ggplot2,
     gridExtra, ramnathv/htmlwidgets, jeroen/jsonlite, yihui/knitr,
     deepayan/lattice, daroczig/logger, MASS,
     insightsengineering/nestcolor, r-lib/rlang,
-    insightsengineering/rtables, sparkline, insightsengineering/teal.data,
+    insightsengineering/rtables, sparkline, rstudio/shinytest2, 
+    insightsengineering/teal.data,
     r-lib/testthat, r-lib/withr
 Config/Needs/website: insightsengineering/nesttemplate
 Encoding: UTF-8

tests/testthat/helper-TealAppDriver.R

@@ -0,0 +1,29 @@
+# Import non-exported TealAppDriver from `teal` package
+TealAppDriver <- getFromNamespace("TealAppDriver", "teal") # nolint: object_name.
+
+# Helper function
+simple_teal_data <- function() {
+  data <- within(teal.data::teal_data(), {
+    require(nestcolor)
+    iris <- iris
+    mtcars <- mtcars
+  })
+  teal.data::datanames(data) <- c("iris", "mtcars")
+  data
+}
+
+simple_cdisc_data <- function(datasets = c("ADSL", "ADRS", "ADTTE")) {
+  datasets <- match.arg(datasets, several.ok = TRUE)
+  data <- within(
+    teal.data::teal_data(),
+    {
+      require(nestcolor)
+      ADSL <- teal.modules.general::rADSL
+      ADRS <- teal.modules.general::rADRS
+      ADTTE <- teal.modules.general::rADTTE
+    }
+  )
+  teal.data::datanames(data) <- datasets
+  teal.data::join_keys(data) <- teal.data::default_cdisc_join_keys[datasets]
+  data
+}

tests/testthat/helper-testing-depth.R

@@ -0,0 +1,49 @@
+#' Returns testing depth set by session option or by environmental variable.
+#'
+#' @details Looks for the session option `TESTING_DEPTH` first.
+#' If not set, takes the system environmental variable `TESTING_DEPTH`.
+#' If neither is set, then returns 3 by default.
+#' If the value of `TESTING_DEPTH` is not a numeric of length 1, then returns 3.
+#'
+#' @return `numeric(1)` the testing depth.
+#'
+get_testing_depth <- function() {
+  default_depth <- 3
+  depth <- getOption("TESTING_DEPTH", Sys.getenv("TESTING_DEPTH", default_depth))
+  depth <- tryCatch(
+    as.numeric(depth),
+    error = function(error) default_depth,
+    warning = function(warning) default_depth
+  )
+  if (length(depth) != 1) depth <- default_depth
+  depth
+}
+
+#' Skipping tests in the testthat pipeline under specific scope
+#' @description This function should be used per each `testthat::test_that` call.
+#'   Each of the call should specify an appropriate depth value.
+#'   The depth value will set the appropriate scope so more/less time consuming tests could be recognized.
+#'   The environment variable `TESTING_DEPTH` is used for changing the scope of `testthat` pipeline.
+#' `TESTING_DEPTH` interpretation for each possible value:
+#' \itemize{
+#' \item{0}{no tests at all}
+#' \item{1}{fast - small scope - executed on every commit}
+#' \item{3}{medium - medium scope - daily integration pipeline}
+#' \item{5}{slow - all tests - daily package tests}
+#' }
+#' @param depth `numeric` the depth of the testing evaluation,
+#'   has opposite interpretation to environment variable `TESTING_DEPTH`.
+#'   So e.g. `0` means run it always and `5` means a heavy test which should be run rarely.
+#'   If the `depth` argument is larger than `TESTING_DEPTH` then the test is skipped.
+#' @importFrom testthat skip
+#' @return `NULL` or invoke an error produced by `testthat::skip`
+#' @note By default `TESTING_DEPTH` is equal to 3 if there is no environment variable for it.
+#' By default `depth` argument lower or equal to 3 will not be skipped because by default `TESTING_DEPTH`
+#' is equal to 3. To skip <= 3 depth tests then the environment variable has to be lower than 3 respectively.
+skip_if_too_deep <- function(depth) { # nolintr
+  checkmate::assert_numeric(depth, len = 1, lower = 0, upper = 5)
+  testing_depth <- get_testing_depth() # by default 3 if there are no env variable
+  if (testing_depth < depth) {
+    testthat::skip(paste("testing depth", testing_depth, "is below current testing specification", depth))
+  }
+}