From c29c33e4f8add6e81b52541434fd5c6b2c358304 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?=
 <211358+averissimo@users.noreply.github.com>
Date: Fri, 19 Apr 2024 17:13:08 +0200
Subject: [PATCH] Adds `TealAppDriver` and `skip_if_too_deep` for e2e testing
 (#1124)

# Pull Request

Part of #1108

## Changes description

- Adds necessary functions for e2e tests on modules
---
 tests/testthat/helper-TealAppDriver.R | 25 ++++++++++++++
 tests/testthat/helper-testing-depth.R | 49 +++++++++++++++++++++++++++
 2 files changed, 74 insertions(+)
 create mode 100644 tests/testthat/helper-TealAppDriver.R
 create mode 100644 tests/testthat/helper-testing-depth.R

diff --git a/tests/testthat/helper-TealAppDriver.R b/tests/testthat/helper-TealAppDriver.R
new file mode 100644
index 0000000000..b28850e396
--- /dev/null
+++ b/tests/testthat/helper-TealAppDriver.R
@@ -0,0 +1,25 @@
+# Initialization function to create a new TealAppDriver object
+#
+# By manipulating the server function as below, we can hint {shinytest2} to load
+# this package and its "Depends".
+# Related to https://github.com/rstudio/shinytest2/issues/381
+init_teal_app_driver <- function(...) {
+  testthat::with_mocked_bindings(
+    {
+      TealAppDriver <- getFromNamespace("TealAppDriver", "teal") # nolint: object_name.
+      TealAppDriver$new(...)
+    },
+    shinyApp = function(ui, server, ...) {
+      functionBody(server) <- bquote({
+        # Hint to shinytest2 that this package should be available (via {globals})
+        .hint_to_load_package <- tm_g_ci # Hint to shinytest2 when looking for packages in globals
+        .(functionBody(server))
+      })
+
+      shiny::shinyApp(ui, server, ...)
+    },
+    # The relevant shinyApp call in `TealAppDriver` is being called without prefix,
+    # hence why the package bindings that is changed is in {teal} and not {shiny}
+    .package = "teal"
+  )
+}
diff --git a/tests/testthat/helper-testing-depth.R b/tests/testthat/helper-testing-depth.R
new file mode 100644
index 0000000000..3aa6cf3ec3
--- /dev/null
+++ b/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))
+  }
+}