Add shinytest2 tests for bslib (#653)

Co-authored-by: André Veríssimo <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>

Author: 3 people

DESCRIPTION

@@ -56,9 +56,11 @@ Imports:
     teal.widgets (>= 0.4.3),
     utils
 Suggests:
+    DT (>= 0.13),
     knitr (>= 1.42),
     MultiAssayExperiment,
     rmarkdown (>= 2.23),
+    shinytest2 (>= 0.4.1),
     SummarizedExperiment,
     testthat (>= 3.2.2),
     withr (>= 3.0.2)
@@ -72,7 +74,7 @@ Config/Needs/verdepcheck: rstudio/shiny, rstudio/bslib, mllg/checkmate,
     daroczig/logger, plotly/plotly, r-lib/R6, daattali/shinycssloaders,
     daattali/shinyjs, dreamRs/shinyWidgets, insightsengineering/teal.data,
     insightsengineering/teal.logger, insightsengineering/teal.widgets,
-    yihui/knitr, bioc::MultiAssayExperiment, bioc::SummarizedExperiment,
+    rstudio/DT, yihui/knitr, bioc::MultiAssayExperiment, bioc::SummarizedExperiment,
     rstudio/rmarkdown, r-lib/testthat, r-lib/withr, bioc::matrixStats
 Config/Needs/website: insightsengineering/nesttemplate
 Encoding: UTF-8

R/FilteredData.R

@@ -532,7 +532,7 @@ FilteredData <- R6::R6Class( # nolint
         include_js_files(pattern = "togglePanelItems"),
         class = "teal-slice",
         bslib::accordion(
-          id = ns("main_filter_accordian"),
+          id = ns("main_filter_accordion"),
           bslib::accordion_panel(
             "Filter Data",
             tags$div(
@@ -578,8 +578,8 @@ FilteredData <- R6::R6Class( # nolint
             });
           ",
               ns("additional_filter_helpers"),
-              ns("main_filter_accordian"),
-              ns("main_filter_accordian"),
+              ns("main_filter_accordion"),
+              ns("main_filter_accordion"),
               ns("additional_filter_helpers")
             )
           )
@@ -710,7 +710,7 @@ FilteredData <- R6::R6Class( # nolint
       tags$div(
         class = "teal-slice",
         bslib::accordion(
-          id = ns("main_filter_accordian"),
+          id = ns("main_filter_accordion"),
           bslib::accordion_panel(
             title = "Active Filter Summary",
             tags$div(

R/FilteredDataset.R

@@ -242,7 +242,7 @@ FilteredDataset <- R6::R6Class( # nolint
                   include_css_files("filter-panel"),
                   include_js_files(pattern = "icons"),
                   bslib::accordion(
-                    id = session$ns("dataset_filter_accordian"),
+                    id = session$ns("dataset_filter_accordion"),
                     class = "teal-slice-dataset-filter",
                     bslib::accordion_panel(
                       dataname,
@@ -298,10 +298,10 @@ FilteredDataset <- R6::R6Class( # nolint
             });
           ",
                         session$ns("filter_util_icons"),
-                        session$ns("dataset_filter_accordian"),
-                        session$ns("dataset_filter_accordian"),
+                        session$ns("dataset_filter_accordion"),
+                        session$ns("dataset_filter_accordion"),
                         session$ns("active_filter_badge"),
-                        session$ns("dataset_filter_accordian")
+                        session$ns("dataset_filter_accordion")
                       )
                     )
                   )
@@ -344,7 +344,7 @@ FilteredDataset <- R6::R6Class( # nolint
                         $('#%s .accordion-button.collapsed').click();
                       }",
                       session$ns("add_panel"),
-                      session$ns("dataset_filter_accordian")
+                      session$ns("dataset_filter_accordion")
                     )
                   )
                 ),
@@ -387,8 +387,8 @@ FilteredDataset <- R6::R6Class( # nolint
 
           # If the accordion input is `NULL` it is being collapsed.
           # It has the accordion panel label if it is expanded.
-          observeEvent(input$dataset_filter_accordian, ignoreNULL = FALSE, {
-            if (is.null(input$dataset_filter_accordian)) {
+          observeEvent(input$dataset_filter_accordion, ignoreNULL = FALSE, {
+            if (is.null(input$dataset_filter_accordion)) {
               # Hiding the `add_panel` dropdown and changing the minus icon to plus
               # TODO: simplify this implementation. This is done in multiple places
               shinyjs::runjs(

tests/testthat/helpers-shinytest2.R

@@ -0,0 +1,26 @@
+default_idle_timeout <- 20000 # Wait (ms) at most until idle
+default_idle_duration <- 200 # Time (ms) it is idle
+
+# Check visibility (borrowed from teal.widgets/tests/testthat/helpers-utils.R)
+is_visible <- function(app_driver, element) {
+  js_script <- sprintf("
+    Array.from(document.querySelectorAll('%s')).map(el => {
+      return el.checkVisibility() && (el.textContent.trim().length > 0 || el.children.length > 0);
+    });
+  ", element)
+
+  any(unlist(app_driver$get_js(js_script)))
+}
+
+# Write a js code to extract the classes
+get_attribute <- function(selector, attribute) {
+  sprintf(
+    "Array.from(document.querySelectorAll('%s')).map(el => el.getAttribute('%s'))",
+    selector, attribute
+  )
+}
+
+is_existing <- function(app_driver, element) {
+  js_script <- sprintf("document.querySelectorAll('%s').length > 0;", element)
+  app_driver$get_js(js_script)
+}

tests/testthat/helpers-testing-depth.R

@@ -0,0 +1,51 @@
+#' 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))
+  }
+}
+
+default_idle_timeout <- 20000