-
-
Notifications
You must be signed in to change notification settings - Fork 13
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Adds necessary shinytest2 helpers for automated tests (#714)
# Pull Request Part of #712 #### Changes description - Allow `TealAppDriver` to be used in tests - R6 class is not yet exported from `{teal}` and needs to be used here - Adds CDISC simple data helper to use in e2e tests - Adds `skip_if_too_deep` function --------- Signed-off-by: André Veríssimo <[email protected]> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
- Loading branch information
1 parent
99d7f02
commit 1cf641f
Showing
4 changed files
with
82 additions
and
1 deletion.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 | ||
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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)) | ||
} | ||
} |