Nothing
# run this line (from project root before check) to pull all tests
# Sys.setenv(SHINYTEST_PULL = normalizePath("tests/testthat/testshiny"))
# this file is required by shiny module tests
# # Interactive vs non-interactive difference present
# # may need to run
# # devtools::load_all()
# # after record test you may do
# # this function is kept for test development and not for test to run.
# # after pulling all tests run tar_pulled_tests
tar_pulled_tests <- function() {
if (nchar(Sys.getenv("SHINYTEST_PULL")) > 0) {
if (file.exists(Sys.getenv("SHINYTEST_PULL"))) {
# setwd is used in interactive case only
# this is not going to impact the package at all.
setwd(dirname(dirname(dirname(Sys.getenv("SHINYTEST_PULL")))))
unlink("tests/testthat/testshiny/testshiny.tar")
tar("tests/testthat/testshiny/testshiny.tar", "tests/testthat/testshiny")
d <- data.frame(fn = list.files("tests/testthat/testshiny/", full.names = TRUE), stringsAsFactors = FALSE)
d$fn0 <- basename(d$fn)
# delete rest files
unlink(d$fn[d$fn0 != "testshiny.tar"], recursive = TRUE)
stop("The tests are pulled.", call. = FALSE)
}
}
}
pull_shiny_test <- function(x, tpath = "tests/testthat/testshiny") {
testf <- list.files(x$app_dir, pattern = "test", include.dirs = TRUE, full.names = TRUE)
here_testf <- file.path(tpath, x$name)
dir.create(here_testf, showWarnings = FALSE, recursive = TRUE)
file.copy(testf, here_testf, overwrite = TRUE, recursive = TRUE)
}
temp_app_create <- function(es, name) {
if (missing(name)) {
stop("give name")
}
td <- tempdir(check = TRUE)
td_this <- tempfile(pattern = "shiny_test_app_dir", tmpdir = td)
unlink(td_this, recursive = TRUE)
dir.create(td_this, showWarnings = FALSE)
tf_for_es <- file.path(td_this, "data")
tf_for_app <- file.path(td_this, "app.R")
saveRDS(es, file = tf_for_es)
# code_this <- paste0("es <- readRDS('",normalizePath(tf_for_es, winslash = "/"),"')\n",
# "shinyApp(es$ui, es$server)\n")
code_this <- paste0(
"es <- readRDS('data')\n",
"shinyApp(es$ui, es$server)\n"
)
writeLines(code_this, tf_for_app)
list(app_dir = td_this, app = tf_for_app, es = tf_for_es, name = name)
}
# if set options(LOCAL_TEST_IN_SHINYTEST = TRUE)
# it will be tested from project root instead of "tests/testthat/"
# this is required as GitHub "LF will be replaced by CRLF"
## The file will have its original line endings in your working directory.
## warning: LF will be replaced by CRLF
untar_tests <- function() {
td_this <- tempdir(check = TRUE)
td_for_test_store <- tempfile("testshiny_", tmpdir = td_this)
dir.create(td_for_test_store, showWarnings = FALSE)
if (identical(getOption("LOCAL_TEST_IN_SHINYTEST"), TRUE)) {
# for internal checks only
message("Testing in local environment. Reading SHINYTEST from project root.")
file.copy("tests/testthat/testshiny/testshiny.tar", to = td_for_test_store)
} else {
file.copy("testshiny/testshiny.tar", to = td_for_test_store)
}
utils::untar(file.path(td_for_test_store, "testshiny.tar"), exdir = td_for_test_store)
fl <- list.files(td_for_test_store, pattern = ".R$", recursive = TRUE, full.names = TRUE)
if (length(fl) == 0) stop("no test files", call. = FALSE)
test_root <- dirname(dirname(dirname(fl[1])))
list(dir = td_for_test_store, test_root = test_root)
}
clean_untars <- function(x) {
unlink(x$dir, recursive = TRUE)
}
copy_test_to_temp_app <- function(x, untar_adds) {
here_testf <- file.path(untar_adds$test_root, x$name, "tests")
if (file.exists(here_testf)) {
file.copy(here_testf, x$app_dir, overwrite = TRUE, recursive = TRUE)
}
}
clean_temp_app <- function(x) {
unlink(x$app)
unlink(x$es)
unlink(x$app_dir, recursive = TRUE)
}
# need to set
# options(TEST_IMAGE_IN_SHINYTEST = TRUE)
# or
# Sys.setenv(TEST_IMAGE_IN_SHINYTEST = "true")
# for testing snapshots
image_test <- function(enable_now) {
# disable on Travis
if (identical(Sys.getenv("TRAVIS"), "true")) {
return(FALSE)
}
if (!missing(enable_now)) {
if (identical(enable_now, TRUE)) {
# sets it for further calls
Sys.setenv(TEST_IMAGE_IN_SHINYTEST = "true")
}
}
# unless TEST_IMAGE_IN_SHINYTEST is set to TRUE it will not run image comparison
opt_chk <- identical(getOption("TEST_IMAGE_IN_SHINYTEST"), TRUE)
env_chk <- identical(Sys.getenv("TEST_IMAGE_IN_SHINYTEST"), "true")
if (env_chk | opt_chk) {
return(TRUE)
}
return(FALSE)
}
test_temp_app <- function(x, test_img, untar_adds) {
copy_test_to_temp_app(x, untar_adds)
img_chk <- image_test()
if (!missing(test_img)) {
if (!identical(test_img, TRUE)) {
img_chk <- FALSE
}
}
if (img_chk) {
message("shintest: checking images")
} else {
message("shintest: NOT checking images")
}
if (nchar(Sys.getenv("SHINYTEST_PULL")) > 0) {
if (file.exists(Sys.getenv("SHINYTEST_PULL"))) {
shinytest::testApp(x$app_dir, compareImages = img_chk)
shinytest::snapshotUpdate(x$app_dir)
pull_shiny_test(x, tpath = Sys.getenv("SHINYTEST_PULL"))
# exit early
return(0)
}
}
shinytest::expect_pass(shinytest::testApp(x$app_dir, compareImages = img_chk))
clean_temp_app(x)
}
inst_deps <- function(x) {
if (rlang::is_installed("shinytest")) {
if (!shinytest::dependenciesInstalled()) {
shinytest::installDependencies()
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.