├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R ├── app-get-all-values.R ├── assertions.R ├── debugging.R ├── event-log.R ├── expect.R ├── files-compare.R ├── initialize.R ├── migrate-shinytest-dir.R ├── on-load.R ├── phantom.R ├── recorder.R ├── save-app.R ├── set-inputs.R ├── shiny-driver.R ├── shiny-mapping.R ├── shinytest-package.R ├── snapshot.R ├── test-app.R ├── testthat.R ├── utils.R ├── view-diff.R └── widget.R ├── README.md ├── _pkgdown.yml ├── cran-comments.md ├── inst ├── app-template.R ├── diffviewerapp │ ├── app.R │ └── www │ │ ├── diffviewerapp.css │ │ ├── exit-nosave.png │ │ └── exit-save.png ├── htmlwidgets │ ├── diffviewer.js │ ├── diffviewer.yaml │ └── lib │ │ ├── diff2html │ │ ├── diff2html-ui.min.js │ │ ├── diff2html.min.css │ │ └── diff2html.min.js │ │ ├── diffviewer │ │ └── diffviewer.css │ │ ├── jquery │ │ └── jquery.min.js │ │ ├── jsdiff │ │ └── diff.js │ │ └── resemble │ │ ├── README.md │ │ └── resemble.js ├── js │ └── shiny-tracer.js └── recorder │ ├── app.R │ ├── recorder.js │ └── www │ ├── exit-nosave.png │ ├── exit-save.png │ ├── inject-recorder.js │ ├── recorder.css │ └── snapshot.png ├── man ├── ShinyDriver.Rd ├── Widget.Rd ├── diffviewer_widget.Rd ├── expectUpdate.Rd ├── expect_pass.Rd ├── installDependencies.Rd ├── migrateShinytestDir.Rd ├── osName.Rd ├── recordTest.Rd ├── registerInputProcessor.Rd ├── shinytest-package.Rd ├── snapshotCompare.Rd ├── testApp.Rd ├── textTestDiff.Rd ├── viewTestDiff.Rd └── viewTestDiffWidget.Rd ├── pkgdown └── extra.css ├── revdep ├── .gitignore ├── README.md ├── cran.md ├── failures.md └── problems.md ├── shinytest.Rproj ├── tests ├── testthat.R └── testthat │ ├── apps │ ├── 006-tabsets-id │ │ ├── DESCRIPTION │ │ ├── Readme.md │ │ ├── server.R │ │ └── ui.R │ ├── 050-kmeans-example │ │ ├── .gitignore │ │ ├── DESCRIPTION │ │ ├── server.R │ │ └── ui.R │ ├── 081-widgets-gallery │ │ ├── DESCRIPTION │ │ ├── server.R │ │ ├── ui.R │ │ ├── widgets.Rproj │ │ └── www │ │ │ └── texturebg.png │ ├── click-me │ │ └── app.R │ ├── embedded-tabs │ │ ├── server.R │ │ └── ui.R │ ├── id-conflicts-1 │ │ └── app.R │ ├── id-conflicts-2 │ │ └── app.R │ ├── id-conflicts-3 │ │ └── app.R │ ├── outputs │ │ └── app.R │ ├── render-args │ │ ├── .gitignore │ │ └── doc.Rmd │ ├── stopApp │ │ └── app.R │ ├── test-exports │ │ └── app.R │ ├── two-rmd │ │ ├── doc1.Rmd │ │ └── doc2.Rmd │ └── user-error │ │ └── app.R │ ├── example_test_dirs │ ├── empty-nested │ │ └── tests │ │ │ ├── shinytest │ │ │ └── file.txt │ │ │ └── st.R │ ├── empty-toplevel │ │ └── tests │ │ │ └── file.R │ ├── mixed-toplevel │ │ └── tests │ │ │ ├── testa.r │ │ │ └── testb.R │ ├── nested │ │ └── tests │ │ │ └── shinytest │ │ │ ├── st.R │ │ │ └── whatever.R │ └── simple │ │ └── tests │ │ ├── testa.r │ │ └── testb.R │ ├── helper-sleep-on-ci.R │ ├── recorded_tests │ ├── .gitignore │ ├── 009-upload │ │ ├── app.R │ │ └── tests │ │ │ └── shinytest │ │ │ ├── mtcars.csv │ │ │ ├── mytest-expected │ │ │ ├── 001.json │ │ │ └── 002.json │ │ │ └── mytest.R │ ├── 041-dynamic-ui │ │ ├── server.R │ │ ├── tests │ │ │ └── shinytest │ │ │ │ ├── mytest-expected │ │ │ │ ├── 001.json │ │ │ │ ├── 002.json │ │ │ │ ├── 003.json │ │ │ │ ├── 004.json │ │ │ │ ├── 005.json │ │ │ │ └── 006.json │ │ │ │ └── mytest.R │ │ └── ui.R │ ├── app-waitForValue │ │ ├── app.R │ │ └── tests │ │ │ └── shinytest │ │ │ ├── mytest-expected │ │ │ ├── 001.json │ │ │ └── 002.json │ │ │ └── mytest.R │ ├── inline-img-src │ │ ├── app.R │ │ └── tests │ │ │ └── shinytest │ │ │ ├── mytest-expected │ │ │ └── 001.json │ │ │ └── mytest.R │ ├── rmd-prerendered │ │ ├── doc.Rmd │ │ └── doc.html │ └── rmd │ │ └── doc.Rmd │ ├── test-app-set-inputs.R │ ├── test-exported-values.R │ ├── test-find-tests.R │ ├── test-helper-rng.R │ ├── test-list-widgets.R │ ├── test-mapping.R │ ├── test-recorded-tests.R │ ├── test-save-app.R │ ├── test-shiny-driver-num-parent.png │ ├── test-shiny-driver-num.png │ ├── test-shiny-driver.R │ ├── test-tabs.R │ ├── test-updates.R │ ├── test-utils.R │ └── test-widget.R └── vignettes ├── .nojekyll ├── ci.Rmd ├── diffviewer.png ├── faq.Rmd ├── ide-editor-script.png ├── ide-menu.png ├── ide-results-fail-output.png ├── ide-results-fail.png ├── ide-results-pass.png ├── ide.Rmd ├── in-depth.Rmd ├── package.Rmd ├── screenshot-exports-app.png ├── screenshot-recorder-1.png ├── screenshot-recorder-2.png ├── screenshot-recorder-name.png ├── screenshot-recorder-random-seed.png ├── shinytest.Rmd └── simple-app ├── .gitignore └── app.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^Makefile$ 4 | ^README.Rmd$ 5 | ^docs$ 6 | ^_pkgdown\.yml$ 7 | ^vignettes$ 8 | ^pkgdown$ 9 | ^\.github$ 10 | ^revdep$ 11 | ^cran-comments\.md$ 12 | ^CRAN-RELEASE$ 13 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/rstudio/shiny-workflows 2 | # 3 | # NOTE: This Shiny team GHA workflow is overkill for most R packages. 4 | # For most R packages it is better to use https://github.com/r-lib/actions 5 | on: 6 | push: 7 | branches: [main, rc-**] 8 | pull_request: 9 | branches: [main] 10 | schedule: 11 | - cron: '0 8 * * 1' # every monday 12 | 13 | name: Package checks 14 | 15 | jobs: 16 | website: 17 | uses: rstudio/shiny-workflows/.github/workflows/website.yaml@v1 18 | with: 19 | pandoc-version: '2.9.2.1' 20 | routine: 21 | uses: rstudio/shiny-workflows/.github/workflows/routine.yaml@v1 22 | with: 23 | pandoc-version: '2.9.2.1' 24 | R-CMD-check: 25 | uses: rstudio/shiny-workflows/.github/workflows/R-CMD-check.yaml@v1 26 | with: 27 | pandoc-version: '2.9.2.1' 28 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | docs 5 | CRAN-RELEASE 6 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinytest 2 | Title: Test Shiny Apps 3 | Version: 1.6.0 4 | Authors@R: 5 | c(person(given = "Winston", 6 | family = "Chang", 7 | role = c("aut", "cre"), 8 | email = "winston@posit.co"), 9 | person(given = "Gábor", 10 | family = "Csárdi", 11 | role = "aut", 12 | email = "gabor@posit.co"), 13 | person(given = "Hadley", 14 | family = "Wickham", 15 | role = "aut", 16 | email = "hadley@posit.co"), 17 | person(given = "Posit Software, PBC", 18 | role = c("cph", "fnd")), 19 | person(given = "Ascent Digital Services", 20 | role = c("cph", "ccp"))) 21 | Description: Please see the shinytest to shinytest2 migration guide at . 22 | License: MIT + file LICENSE 23 | URL: https://github.com/rstudio/shinytest 24 | BugReports: https://github.com/rstudio/shinytest/issues 25 | Imports: 26 | assertthat, 27 | callr (>= 2.0.3), 28 | crayon, 29 | debugme, 30 | digest, 31 | htmlwidgets, 32 | httpuv, 33 | httr, 34 | jsonlite, 35 | parsedate, 36 | pingr, 37 | R6, 38 | rematch, 39 | rlang, 40 | rstudioapi (>= 0.8.0.9002), 41 | shiny (>= 1.3.2), 42 | testthat (>= 1.0.0), 43 | utils, 44 | webdriver (>= 1.0.6), 45 | withr 46 | Suggests: 47 | flexdashboard, 48 | globals, 49 | rmarkdown 50 | Encoding: UTF-8 51 | Roxygen: list(markdown = TRUE) 52 | RoxygenNote: 7.3.1 53 | SystemRequirements: PhantomJS (http://phantomjs.org/) 54 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: Mango Solutions 3 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: README.md 3 | 4 | README.md: README.Rmd 5 | Rscript -e "library(knitr); knit('$<', output = '$@', quiet = TRUE)" 6 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(format,shinytest_logs) 4 | S3method(print,shinytest_logs) 5 | export(ShinyDriver) 6 | export(dependenciesInstalled) 7 | export(diffviewer_widget) 8 | export(expectUpdate) 9 | export(expect_pass) 10 | export(getInputProcessors) 11 | export(installDependencies) 12 | export(migrateShinytestDir) 13 | export(osName) 14 | export(recordTest) 15 | export(registerInputProcessor) 16 | export(snapshotCompare) 17 | export(snapshotUpdate) 18 | export(testApp) 19 | export(textTestDiff) 20 | export(viewTestDiff) 21 | export(viewTestDiffWidget) 22 | import(rlang) 23 | import(shiny) 24 | importFrom(R6,R6Class) 25 | importFrom(assertthat,"on_failure<-") 26 | importFrom(assertthat,assert_that) 27 | importFrom(callr,process) 28 | importFrom(crayon,blue) 29 | importFrom(crayon,cyan) 30 | importFrom(crayon,magenta) 31 | importFrom(crayon,make_style) 32 | importFrom(debugme,debugme) 33 | importFrom(parsedate,parse_date) 34 | importFrom(pingr,ping_port) 35 | importFrom(rematch,re_match) 36 | importFrom(testthat,expect) 37 | importFrom(utils,compareVersion) 38 | importFrom(utils,packageName) 39 | importFrom(webdriver,Session) 40 | importFrom(webdriver,run_phantomjs) 41 | importFrom(withr,with_envvar) 42 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # shinytest 1.6.0 2 | 3 | * shinytest is now officially deprecated. Please use shinytest2 instead. 4 | 5 | # shinytest 1.5.4 6 | 7 | * Updated contact information in DESCRIPTION file. (#436) 8 | 9 | # shinytest 1.5.3 10 | 11 | * The `tryInvokeRestart()` function (used in shinytest 1.5.2) was added in R 4.0. This version replaces it with code that will work in older versions of R. 12 | 13 | # shinytest 1.5.2 14 | 15 | * Messages emitted at load time are now converted to `packageStartupMessage`s so that they can be suppressed with `suppressPackageStartupMessages()`. 16 | 17 | # shinytest 1.5.1 18 | 19 | * `ShinyDriver$initialize()` now waits for the browser to navigate to the page before it injects the JavaScript testing code. This is needed when using phantomjs 2.5.0-beta. (#388) 20 | 21 | * The diffviewer widget previously ignored some very minor pixel differences, but now it will show every difference in red. (#391) 22 | 23 | * Added support for displaying text differences for files with a `.txt` extension. Files that do not display text differences will now display a hash of the file contents (#407) 24 | 25 | # shinytest 1.5.0 26 | 27 | * `ShinyDriver$takeSnapshot()` gains ability to take a snapshot of a single 28 | element (#260). 29 | 30 | * New `Widget$getHtml()` returns the complete HTML of the selected widget 31 | (#347). 32 | 33 | * Add new `osName()` function, which returns the name of the operating system. 34 | (#368) 35 | 36 | * `ShinyDriver$intialize()` gains two new arguments: 37 | * `renderArgs`: a list of arguments to `rmarkdown::run()`, making it possible to set parameters for parameterised `runtime: shiny` Rmd documents (#249). 38 | * `options`: a list of arguments to `base::options()`, making it possible to set options in the child process which runs the application (#373). 39 | 40 | * `ShinyDriver$getAllValues()`, `ShinyDriver$snapshot()`, and 41 | `ShinyDriver$snapshotDownload()` give clear errors messages if the Shiny 42 | app is no longer running (e.g. because you've trigged a `stopApp()`) (#192). 43 | 44 | * `ShinyDriver$snapshotDownload()` gives a clear error message if the 45 | `fileInput()` does not exist (#191) 46 | 47 | * New `Widget$click()` method to click buttons (#325). 48 | 49 | * New `ShinyDriver$waitForShiny()` that waits until Shiny is done computing 50 | on the reactive graph (#327). 51 | 52 | * `testApp()` can now take a path to a directory containing a single 53 | interactive `.Rmd` (#334). 54 | 55 | * Fixed [#206](https://github.com/rstudio/shinytest/issues/206): On Windows, non-ASCII characters in JSON snapshots were written using the native encoding, instead of UTF-8. ([#318](https://github.com/rstudio/shinytest/pull/318), [#320](https://github.com/rstudio/shinytest/pull/320)) 56 | 57 | * Added `registerInputProcessor()`, which allows other packages to control how code is generated when recording input values from input bindings from that package. ([#321]) 58 | 59 | # shinytest 1.4.0 60 | 61 | * Recommend that tests be placed in `tests/shinytest/` instead of directly in the tests directory. Users with their tests in the `tests/` directory will now see a message about this change. Storing shinytests directly in `tests/` will be deprecated in the future. The new function `migrateShinytestDir()` will migrate from the old to the new directory layout. 62 | 63 | * Also display the message about where to find the diff when the diff viewer was opened but the diffs were not accepted. ([#131](https://github.com/rstudio/shinytest/issues/131)) 64 | 65 | * Added new `suffix` option, which allows adding a suffix to an expected results directory. This makes it possible to store multiple sets of results, which can be useful, for example, if you run tests on multiple platforms. ([#295](https://github.com/rstudio/shinytest/pull/295)) 66 | 67 | * Previously, on Windows, the reported resolution of screenshots depended on the actual screen resolution. For example, on one Windows machine, it might report a screenshot to be 96 ppi, while on another machine, it might report it to be 240 ppi, even though the image data is exactly the same from the two machines. This caused problems when expected results were generated on one machine and the tests were run on another machine. Now, the screenshots are modified so that they always report 72 ppi resolution, which is the same as on Mac and Linux. ([#297](https://github.com/rstudio/shinytest/pull/297)) 68 | 69 | * Added new `ShinyDriver` method `app$waitForValue()` which will wait until the current application's `input` (or `output`) value is not one of the supplied invalid values. ([#304](https://github.com/rstudio/shinytest/pull/304)) 70 | 71 | # shinytest 1.3.1 72 | 73 | ## New features 74 | 75 | * Added support for setting inputs that do not have an input binding (#232); furthermore, inputs set with event priority (e.g., `Shiny.setInputValue('key', 'value', {priority: 'event'})`) are also supported (#239). 76 | 77 | * Added support for triggering snapshots from the keyboard (by pressing Ctrl-Shift-S or Command-Shift-S) while recording tests with `recordTest()` (#240). 78 | 79 | * `recordTest()` gains a `debug` argument for displaying (`"shiny_console"`, `"browser"`, and/or `"shinytest`) logs into the R console (#146). When these logs are displayed, they use `format.shinytest_logs()` with `short = TRUE` which suppress the timestamp and level. 80 | 81 | ## Bug fixes 82 | 83 | * Recording a test that produces an input value with an escape character, '\', no longer results in error (#241). 84 | 85 | ## Improvements 86 | 87 | * `ShinyDriver` now passes the current `RNGkind()` to the background R process that serves up the app being tested. This allows for better control over randomness across mutliple versions of R with different `RNGkind()` defaults (e.g., 3.5 and 3.6) 88 | 89 | # shinytest 1.3.0 90 | 91 | * First public release 92 | -------------------------------------------------------------------------------- /R/app-get-all-values.R: -------------------------------------------------------------------------------- 1 | # Note: This queries the server 2 | sd_getAllValues <- function(self, private, input, output, export) { 3 | self$logEvent("Getting all values") 4 | "!DEBUG sd_getAllValues" 5 | 6 | url <- private$getTestSnapshotUrl(input, output, export, format = "rds") 7 | req <- httr_get(url) 8 | 9 | tmpfile <- tempfile() 10 | on.exit(unlink(tmpfile)) 11 | writeBin(req$content, tmpfile) 12 | readRDS(tmpfile) 13 | } 14 | -------------------------------------------------------------------------------- /R/assertions.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom assertthat assert_that on_failure<- 3 | 4 | is_string <- function(x) { 5 | is.character(x) && length(x) == 1 && !is.na(x) 6 | } 7 | 8 | on_failure(is_string) <- function(call, env) { 9 | paste0(deparse(call$x), " is not a string (length 1 character)") 10 | } 11 | 12 | is_host <- function(x) { 13 | assert_that(is_string(x)) 14 | } 15 | 16 | on_failure(is_host) <- function(call, env) { 17 | paste0(deparse(call$x), " does not look like a host name") 18 | } 19 | 20 | is_count <- function(x) { 21 | is.numeric(x) && length(x) == 1 && as.integer(x) == x 22 | } 23 | 24 | on_failure(is_count) <- function(call, env) { 25 | paste0(deparse(call$x), " is not a count (length 1 integer)") 26 | } 27 | 28 | is_port <- function(x) { 29 | assert_that(is_count(x)) 30 | } 31 | 32 | on_failure(is_port) <- function(call, env) { 33 | paste0(deparse(call$x), " is not a port number") 34 | } 35 | 36 | is_url_path <- function(x) { 37 | assert_that(is_string(x) && grepl("^/", x)) 38 | } 39 | 40 | on_failure(is_url_path) <- function(call, env) { 41 | paste0(deparse(call$x), " is not a path for a URL") 42 | } 43 | 44 | is_all_named <- function(x) { 45 | length(names(x)) == length(x) && all(names(x) != "") 46 | } 47 | 48 | on_failure(is_all_named) <- function(call, env) { 49 | paste0(deparse(call$x), " has entries without names") 50 | } 51 | 52 | is_date <- function(x) { 53 | inherits(x, "Date") 54 | } 55 | 56 | on_failure(is_date) <- function(call, env) { 57 | paste0(deparse(call$x), " is not a date or vector of dates") 58 | } 59 | 60 | is_date_range <- function(x) { 61 | assert_that(is_date(x)) 62 | length(x) == 2 63 | } 64 | 65 | on_failure(is_date_range) <- function(call, env) { 66 | paste0(deparse(call$x), " is not a date range (length 2 date vector)") 67 | } 68 | 69 | is_scalar_number <- function(x) { 70 | is.numeric(x) && length(x) == 1 && ! is.na(x) 71 | } 72 | 73 | on_failure(is_scalar_number) <- function(call, env) { 74 | paste0(deparse(call$x), " is not a scalar number") 75 | } 76 | 77 | is_numeric <- function(x, .length = 1) { 78 | is.numeric(x) && length(x) == .length && all(! is.na(x)) 79 | } 80 | 81 | on_failure(is_numeric) <- function(call, env) { 82 | paste0( 83 | deparse(call$x), 84 | " is not length ", env$.length, " numeric or has missing values" 85 | ) 86 | } 87 | 88 | as_debug <- function(x) { 89 | assert_that(is.character(x)) 90 | x <- unique(x) 91 | 92 | miss <- ! x %in% c(ShinyDriver$debugLogTypes, c("all", "none")) 93 | 94 | if (any(miss)) { 95 | abort(paste0("Unknown debug types: ", paste(x[miss], collapse = ", "))) 96 | } 97 | 98 | if ("all" %in% x) x <- ShinyDriver$debugLogTypes 99 | if ("none" %in% x) x <- character() 100 | 101 | x 102 | } 103 | -------------------------------------------------------------------------------- /R/debugging.R: -------------------------------------------------------------------------------- 1 | 2 | sd_setupDebugging <- function(self, private, debug) { 3 | "!DEBUG sd_setupDebugging" 4 | debug <- as_debug(debug) 5 | 6 | if (length(debug)) { 7 | ## TODO: poll the logs 8 | } 9 | } 10 | 11 | sd_getDebugLog <- function(self, private, type) { 12 | "!DEBUG sd_getDebugLog" 13 | 14 | type <- as_debug(type) 15 | 16 | output <- list() 17 | 18 | # It's possible for there not to be a shinyProcess object, if we're testing 19 | # against a remote server (as in shinyloadtest). 20 | if (!is.null(private$shinyProcess) && "shiny_console" %in% type) { 21 | "!DEBUG sd_getDebugLog shiny_console" 22 | out <- readLines(private$shinyProcess$get_output_file(), warn = FALSE) 23 | err <- readLines(private$shinyProcess$get_error_file(), warn = FALSE) 24 | output$shiny_console <- make_shiny_console_log(out = out, err = err) 25 | } 26 | 27 | if ("browser" %in% type) { 28 | "!DEBUG sd_getDebugLog browser" 29 | output$browser <- make_browser_log(private$web$readLog()) 30 | } 31 | 32 | if ("shinytest" %in% type) { 33 | "!DEBUG sd_getDebugLog shinytest log" 34 | output$shinytest <- make_shinytest_log(private$web$executeScript( 35 | "if (! window.shinytest) { return([]) } 36 | var res = window.shinytest.log_entries; 37 | window.shinytest.log_entries = []; 38 | return res;" 39 | )) 40 | } 41 | 42 | merge_logs(output) 43 | } 44 | 45 | sd_enableDebugLogMessages <- function(self, private, enable = TRUE) { 46 | private$web$executeScript( 47 | "window.shinytest.log_messages = arguments[0]", 48 | enable 49 | ) 50 | } 51 | 52 | make_shiny_console_log <- function(out, err) { 53 | out <- data.frame( 54 | stringsAsFactors = FALSE, 55 | level = if (length(out)) "INFO" else character(), 56 | timestamp = if (length(out)) as.POSIXct(NA) else as.POSIXct(character()), 57 | message = filter_log_text(out), 58 | type = if (length(out)) "shiny_console" else character() 59 | ) 60 | err <- data.frame( 61 | stringsAsFactors = FALSE, 62 | level = if (length(err)) "ERROR" else character(), 63 | timestamp = if (length(err)) as.POSIXct(NA) else as.POSIXct(character()), 64 | message = filter_log_text(err), 65 | type = if (length(err)) "shiny_console" else character() 66 | ) 67 | rbind(out, err) 68 | } 69 | 70 | make_browser_log <- function(log) { 71 | log$type <- if (nrow(log)) "browser" else character() 72 | log[, c("level", "timestamp", "message", "type")] 73 | } 74 | 75 | #' @importFrom parsedate parse_date 76 | 77 | make_shinytest_log <- function(entries) { 78 | data.frame( 79 | stringsAsFactors = FALSE, 80 | level = if (length(entries)) "INFO" else character(), 81 | # Workaround for bug in parsedate::parse_date where it errors on empty input: 82 | # https://github.com/gaborcsardi/parsedate/issues/20 83 | timestamp = if (length(entries)) parse_date(vapply(entries, "[[", "", "timestamp")) 84 | else as.POSIXct(character()), 85 | message = vapply(entries, "[[", "", "message"), 86 | type = if (length(entries)) "shinytest" else character() 87 | ) 88 | } 89 | 90 | merge_logs <- function(output) { 91 | log <- do.call(rbind, output) 92 | log <- log[order(log$timestamp), ] 93 | class(log) <- c("shinytest_logs", class(log)) 94 | log 95 | } 96 | 97 | 98 | # Remove problem characters from log text. Currently just "\f", which clears the 99 | # console in RStudio. 100 | filter_log_text <- function(str) { 101 | gsub("\f", "", str, fixed = TRUE) 102 | } 103 | 104 | #' @export 105 | #' @importFrom crayon blue magenta cyan make_style 106 | 107 | format.shinytest_logs <- function(x, ..., short = FALSE) { 108 | 109 | colors <- list( 110 | shiny_console = magenta, 111 | browser = cyan, 112 | shinytest = blue 113 | ) 114 | 115 | types <- c( 116 | shiny_console = "C", 117 | browser = "B", 118 | shinytest = "S" 119 | ) 120 | 121 | lines <- vapply(seq_len(nrow(x)), function(i) { 122 | 123 | if (short) { 124 | return( 125 | paste0( 126 | types[x$type[i]], "> ", 127 | colors[[ x$type[i] ]](x$message[i]) 128 | ) 129 | ) 130 | } 131 | 132 | time <- if (is.na(x$timestamp[i])) { 133 | "-----------" 134 | } else { 135 | format(x$timestamp[i], "%H:%M:%OS2") 136 | } 137 | 138 | paste( 139 | sep = "", 140 | types[x$type[i]], 141 | "/", 142 | substr(x$level[i], 1, 1), 143 | " ", 144 | time, 145 | " ", 146 | colors[[ x$type[i] ]](x$message[i]) 147 | ) 148 | }, character(1)) 149 | 150 | paste(lines, collapse = "\n") 151 | } 152 | 153 | #' @export 154 | #' @importFrom crayon blue magenta cyan make_style 155 | 156 | print.shinytest_logs <- function(x, ..., short = FALSE) { 157 | cat(format(x, short = short), ...) 158 | invisible(x) 159 | } 160 | -------------------------------------------------------------------------------- /R/event-log.R: -------------------------------------------------------------------------------- 1 | sd_logEvent <- function(self, private, event, ...) { 2 | content <- list(time = Sys.time(), event = event, ...) 3 | assert_that(is_all_named(content)) 4 | 5 | private$eventLog[[length(private$eventLog) + 1]] <- content 6 | } 7 | 8 | sd_getEventLog <- function(self, private) { 9 | log <- private$eventLog 10 | 11 | # Log is a row-first list of lists which we need to convert to a data frame. 12 | # Also, rows don't all have the same column names, so we'll 13 | all_names <- unique(unlist(lapply(log, names))) 14 | names(all_names) <- all_names 15 | 16 | vecs <- lapply(all_names, function(nm) { 17 | col <- lapply(log, `[[`, nm) 18 | 19 | # Replace NULLs with NA so that they don't get lost in conversion from list 20 | # to vector. 21 | null_idx <- vapply(col, is.null, logical(1)) 22 | col[null_idx] <- NA 23 | # Convert to list. Use do.call(c) instead of unlist() because the latter will 24 | # convert dates and times to numbers. 25 | do.call(c, col) 26 | }) 27 | 28 | # Add workerId as first column 29 | vecs <- c(workerid = private$shinyWorkerId, vecs) 30 | 31 | as.data.frame(vecs, stringsAsFactors = FALSE) 32 | } 33 | -------------------------------------------------------------------------------- /R/expect.R: -------------------------------------------------------------------------------- 1 | 2 | #' `testthat` expectation for a Shiny update 3 | #' 4 | #' @param app A [ShinyDriver()] object. 5 | #' @param output Character vector, the name(s) of the output widgets 6 | #' that are required to update for the test to succeed. 7 | #' @param ... Named arguments specifying updates for Shiny input 8 | #' widgets. 9 | #' @param timeout Timeout for the update to happen, in milliseconds. 10 | #' @param iotype Type of the widget(s) to change. These are normally 11 | #' input widgets. 12 | #' 13 | #' @export 14 | #' @importFrom testthat expect 15 | #' @importFrom utils compareVersion 16 | #' @examples 17 | #' \dontrun{ 18 | #' ## https://github.com/rstudio/shiny-examples/tree/main/050-kmeans-example 19 | #' app <- ShinyDriver$new("050-kmeans-example") 20 | #' expectUpdate(app, xcol = "Sepal.Width", output = "plot1") 21 | #' expectUpdate(app, ycol = "Petal.Width", output = "plot1") 22 | #' expectUpdate(app, clusters = 4, output = "plot1") 23 | #' } 24 | #' @keywords internal 25 | expectUpdate <- function(app, output, ..., timeout = 3000, 26 | iotype = c("auto", "input", "output")) { 27 | app$expectUpdate( 28 | output, 29 | ..., 30 | timeout = timeout, 31 | iotype = match.arg(iotype) 32 | ) 33 | } 34 | 35 | sd_expectUpdate <- function(self, private, output, ..., timeout, 36 | iotype) { 37 | "!DEBUG sd_expectUpdate `paste(output, collapse = ', ')`" 38 | 39 | assert_that(is.character(output)) 40 | assert_that(is_all_named(inputs <- list(...))) 41 | assert_that(is_count(timeout)) 42 | assert_that(is_string(iotype)) 43 | 44 | ## Make note of the expected updates. They will be ticked off 45 | ## one by one by the JS event handler in shiny-tracer.js 46 | js <- paste0( 47 | "window.shinytest.updating.push('", output, "');", 48 | collapse = "\n" 49 | ) 50 | private$web$executeScript(js) 51 | on.exit( 52 | private$web$executeScript("window.shinytest.updating = [];"), 53 | add = TRUE 54 | ) 55 | 56 | ## Do the changes to the inputs 57 | for (n in names(inputs)) { 58 | self$findWidget(n, iotype = iotype)$setValue(inputs[[n]]) 59 | } 60 | 61 | "!DEBUG waiting for update" 62 | ## Wait for all the updates to happen, or a timeout 63 | res <- private$web$waitFor( 64 | "window.shinytest.updating.length == 0", 65 | timeout = timeout 66 | ) 67 | "!DEBUG update done (`if (res) 'done' else 'timeout'`)" 68 | 69 | expect( 70 | res, 71 | sprintf( 72 | strwrap(paste0( 73 | "Updating %s did not update %s, or it is taking longer ", 74 | "than %i ms.")), 75 | paste(sQuote(names(inputs)), collapse = ", "), 76 | paste(sQuote(output), collapse = ", "), 77 | timeout 78 | ) 79 | ) 80 | 81 | ## "updating" is cleaned up automatically by on.exit() 82 | } 83 | -------------------------------------------------------------------------------- /R/files-compare.R: -------------------------------------------------------------------------------- 1 | files_identical <- function(a, b, preprocess = NULL) { 2 | if (!file.exists(a)) { 3 | inform(paste0("File ", a, " not found.")) 4 | return(FALSE) 5 | } 6 | if (!file.exists(b)) { 7 | inform(message("File ", b, " not found.")) 8 | return(FALSE) 9 | } 10 | 11 | # Fast path: if not the same size, return FALSE 12 | a_size <- file.info(a)$size 13 | b_size <- file.info(b)$size 14 | if (!identical(a_size, b_size)) { 15 | return(FALSE) 16 | } 17 | 18 | a_content <- read_raw(a) 19 | b_content <- read_raw(b) 20 | 21 | if (!is.null(preprocess)) { 22 | a_content <- preprocess(a, a_content) 23 | b_content <- preprocess(b, b_content) 24 | } 25 | 26 | identical(a_content, b_content) 27 | } 28 | 29 | # `expected` and `current` are directories. `file_preprocess` is an optional 30 | # function that takes two arguments, `name` (a filename) and `content` (a raw 31 | # vector of the file's contents). If present, the `file_preprocess` function 32 | # will be used to prepare file contents before they are compared. 33 | dirs_differ <- function(expected, current, file_preprocess = NULL) { 34 | diff_found <- FALSE 35 | 36 | if (!dir_exists(expected)) abort(paste0("Directory ", expected, " not found.")) 37 | if (!dir_exists(current)) abort(paste0("Directory ", current, " not found.")) 38 | 39 | expected_files <- list.files(expected) 40 | current_files <- list.files(current) 41 | 42 | # Compare individual files 43 | all_files <- sort(union(expected_files, current_files)) 44 | res <- lapply(all_files, function(file) { 45 | expected_file <- file.path(expected, file) 46 | current_file <- file.path(current, file) 47 | 48 | res <- list( 49 | name = file, 50 | expected = file.exists(expected_file), 51 | current = file.exists(current_file) 52 | ) 53 | 54 | if (res$expected && res$current) { 55 | res$identical <- files_identical(expected_file, current_file, file_preprocess) 56 | } else { 57 | res$identical <- NA 58 | } 59 | res 60 | }) 61 | 62 | # Convert to data frame 63 | data.frame( 64 | name = vapply(res, `[[`, "name", FUN.VALUE = ""), 65 | expected = vapply(res, `[[`, "expected", FUN.VALUE = TRUE), 66 | current = vapply(res, `[[`, "current", FUN.VALUE = TRUE), 67 | identical = vapply(res, `[[`, "identical", FUN.VALUE = TRUE) 68 | ) 69 | } 70 | 71 | 72 | # Return path to a diff program. Either `diff` or, if not found, then use `fc` 73 | # (Windows only). 74 | which_diff <- function() { 75 | path <- Sys.which("diff") 76 | if (path != "") 77 | return(path) 78 | 79 | if (is_windows()) { 80 | path <- Sys.which("fc") 81 | if (path != "") 82 | return(path) 83 | 84 | abort("No program named `diff` or `fc` found in path.") 85 | } 86 | abort("No program named `diff` found in path.") 87 | } 88 | 89 | 90 | # Return a text diff of two files or directories. First attempts to use `diff` 91 | # program, but if not found, will fall back to using `fc` on Windows. The format 92 | # of the output therefore can vary on different platforms. 93 | # 94 | # If present, the `file_preprocess` function will be used to prepare file 95 | # contents before they are compared. 96 | diff_files <- function(file1, file2, file_preprocess = NULL) { 97 | diff_prog <- which_diff() 98 | 99 | tmp_dir <- tempfile("shinytest-diff-") 100 | dir.create(tmp_dir) 101 | on.exit(unlink(tmp_dir, recursive = TRUE)) 102 | out_file <- file.path(tmp_dir, "shinytest-diff-output.txt") 103 | 104 | 105 | # If there's a preprocess function, we need to copy the files to a temp 106 | # directory and preprocess them before we can compare them. 107 | if (!is.null(file_preprocess)) { 108 | tmp_file1 <- file.path(tmp_dir, basename(file1)) 109 | tmp_file2 <- file.path(tmp_dir, basename(file2)) 110 | 111 | file.copy(file1, tmp_dir, recursive = TRUE) 112 | file.copy(file2, tmp_dir, recursive = TRUE) 113 | 114 | # Remove image hashes from tmp_file1 and tmp_file2. They can be files or 115 | # directories. 116 | lapply( 117 | list(tmp_file1, tmp_file2), 118 | function(path) { 119 | if (file.info(path)$isdir) { 120 | lapply(dir(path, full.names = TRUE), file_preprocess) 121 | } else { 122 | file_preprocess(path) 123 | } 124 | } 125 | ) 126 | 127 | file1 <- tmp_file1 128 | file2 <- tmp_file2 129 | 130 | working_dir <- tmp_dir 131 | } else { 132 | working_dir <- getwd() 133 | } 134 | 135 | withr::with_dir(working_dir, 136 | { 137 | p <- process$new( 138 | command = which_diff(), 139 | stdout = out_file, 140 | args = c(file1, file2) 141 | ) 142 | } 143 | ) 144 | p$wait(timeout = 5000) 145 | p$kill() 146 | 147 | if (p$get_exit_status() == 0) { 148 | status <- "accept" 149 | } else { 150 | status <- "reject" 151 | } 152 | 153 | structure( 154 | read_utf8(out_file), 155 | status = status 156 | ) 157 | } 158 | -------------------------------------------------------------------------------- /R/migrate-shinytest-dir.R: -------------------------------------------------------------------------------- 1 | #' Migrate legacy \pkg{shinytest} files to new test directory structure 2 | #' 3 | #' This function migrates the old-style directory structure used by 4 | #' \pkg{shinytest} (versions 1.3.1 and below) to new test directory structure 5 | #' used in shinytest 1.4.0 and above. 6 | #' 7 | #' Before \pkg{shinytest} 1.4.0, the shinytest scripts and results were put in a 8 | #' subdirectory of the application named `tests/`. As of \pkg{shinytest} 1.4.0, 9 | #' the tests are put in `tests/shinytest/`, so that it works with the 10 | #' `runTests()` function shiny package (added in \pkg{shiny} 1.5.0). 11 | #' 12 | #' With \pkg{shinytest} 1.3.1 and below, the tests/ subdirectory of the 13 | #' application was used specifically for \pkg{shinytest}, and could not be used 14 | #' for other types of tests. So the directory structure would look like this: 15 | #' 16 | #' ``` 17 | #' appdir/ 18 | #' `- tests 19 | #' `- mytest.R 20 | #' ``` 21 | #' 22 | #' In Shiny 1.5.0, the `shiny::runTests()` function was added, and it will run 23 | #' test scripts tests/ subdirectory of the application. This makes it possible 24 | #' to use other testing systems in addition to shinytest. \pkg{shinytest} 1.4.0 25 | #' is designed to work with this new directory structure. The directory 26 | #' structure looks something like this: 27 | #' 28 | #' ``` 29 | #' appdir/ 30 | #' |- R 31 | #' |- tests 32 | #' |- shinytest.R 33 | #' |- shinytest 34 | #' | `- mytest.R 35 | #' |- testthat.R 36 | #' `- testthat 37 | #' `- test-script.R 38 | #' ``` 39 | #' 40 | #' This allows for tests using the \pkg{shinytest} package as well as other 41 | #' testing tools, such as the `shiny::testServer()` function, which can be used 42 | #' for testing module and server logic, and for unit tests of functions in an R/ 43 | #' subdirectory. 44 | #' 45 | #' In \pkg{shinytest} 1.4.0 and above, it defaults to creating the new directory 46 | #' structure. 47 | #' 48 | #' @param appdir A directory containing a Shiny application. 49 | #' @param dryrun If `TRUE`, print out the changes that would be made, but don't 50 | #' actually do them. 51 | #' 52 | #' @export 53 | migrateShinytestDir <- function(appdir, dryrun = FALSE) { 54 | tests_dir <- file.path(appdir, "tests") 55 | if (!file.exists(tests_dir)) { 56 | inform(paste0(tests_dir, " does not exist; doing nothing.")) 57 | return(invisible(FALSE)) 58 | } 59 | 60 | shinytest_dir <- file.path(tests_dir, "shinytest") 61 | if (file.exists(shinytest_dir)) { 62 | inform(paste0(shinytest_dir, " exists; doing nothing.")) 63 | return(invisible(FALSE)) 64 | } 65 | 66 | inform(paste0("Moving tests from ", tests_dir, " to ", shinytest_dir)) 67 | if (!dryrun) { 68 | shinytest_temp_dir <- file.path(appdir, "shinytest") 69 | file.rename(tests_dir, shinytest_temp_dir) 70 | dir.create(tests_dir) 71 | invisible(file.rename(shinytest_temp_dir, shinytest_dir)) 72 | } 73 | 74 | update_test_script <- function(file) { 75 | inform(paste0("Updating test script ", file)) 76 | if (!dryrun) { 77 | txt <- readLines(file) 78 | txt <- sub('ShinyDriver$new("../', 'ShinyDriver$new("../../', txt, fixed = TRUE) 79 | writeLines(txt, file) 80 | } 81 | } 82 | 83 | if (dryrun) { 84 | script_files <- list.files(tests_dir, pattern = "\\.R", full.names = TRUE) 85 | script_files <- file.path(dirname(script_files), "shinytest", basename(script_files)) 86 | } else { 87 | script_files <- list.files(shinytest_dir, pattern = "\\.R", full.names = TRUE) 88 | } 89 | lapply(script_files, update_test_script) 90 | 91 | # Create tests/shinytest.R 92 | shinytest_script <- file.path(tests_dir, "shinytest.R") 93 | if (!file.exists(shinytest_script)) { 94 | inform(paste0("Creating ", shinytest_script)) 95 | if (!dryrun) { 96 | writeLines( 97 | c('library(shinytest)', 'shinytest::testApp("../")'), 98 | shinytest_script 99 | ) 100 | } 101 | } 102 | 103 | invisible(TRUE) 104 | } 105 | -------------------------------------------------------------------------------- /R/on-load.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom debugme debugme 3 | 4 | .onLoad <- function(libname, pkgname) { 5 | debugme() 6 | 7 | packageStartupMessage( 8 | "IMPORTANT! shinytest is deprecated and may not work with shiny>1.8.1.1.\n", 9 | "Please switch to shinytest2.\n", 10 | "See https://rstudio.github.io/shinytest2/articles/z-migration.html" 11 | ) 12 | 13 | # This will issue a message if phantomjs isn't found, converting the regular 14 | # message to a packageStartupMessage. 15 | convert_message_to_package_startup_message({ 16 | find_phantom() 17 | }) 18 | } 19 | 20 | 21 | # Evaluate an expression, and if it emits any messsages, convert them to 22 | # packageStartupMessage. 23 | convert_message_to_package_startup_message <- function(expr) { 24 | withCallingHandlers( 25 | force(expr), 26 | message = function(cnd) { 27 | packageStartupMessage(conditionMessage(cnd)) 28 | maybe_restart("muffleMessage") 29 | } 30 | ) 31 | } 32 | 33 | 34 | # This is equivalent to tryInvokeRestart, but that function is available only in 35 | # R 4.0 and above. 36 | maybe_restart <- function(restart) { 37 | if (!is.null(findRestart(restart))) { 38 | invokeRestart(restart) 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /R/phantom.R: -------------------------------------------------------------------------------- 1 | #' Checks for/installs dependencies 2 | #' 3 | #' `dependenciesInstalled()` that all the required system dependency, 4 | #' PhantomJS, is installed, and `installDependencies()` installs it if needed. 5 | #' For more information about where PhantomJS will be installed 6 | #' see [webdriver::install_phantomjs()]. 7 | #' 8 | #' @return `TRUE` when all dependencies are fulfilled; otherwise, `FALSE`. 9 | #' @export 10 | #' @rdname installDependencies 11 | dependenciesInstalled <- function() { 12 | !is.null(find_phantom(quiet = TRUE)) 13 | } 14 | 15 | #' @rdname installDependencies 16 | #' @export 17 | installDependencies <- function() { 18 | if (is.null(find_phantom(quiet = TRUE))) { 19 | webdriver::install_phantomjs() 20 | } 21 | } 22 | 23 | # Find PhantomJS from PATH, APPDATA, system.file('webdriver'), ~/bin, etc 24 | find_phantom <- function(quiet = FALSE) { 25 | path <- Sys.which( "phantomjs" ) 26 | if (path != "") return(path) 27 | 28 | for (d in phantom_paths()) { 29 | exec <- if (is_windows()) "phantomjs.exe" else "phantomjs" 30 | path <- file.path(d, exec) 31 | if (utils::file_test("-x", path)) break else path <- "" 32 | } 33 | 34 | if (path == "") { 35 | if (!quiet) { 36 | # It would make the most sense to throw an error here. However, that would 37 | # cause problems with CRAN. The CRAN checking systems may not have phantomjs 38 | # and may not be capable of installing phantomjs (like on Solaris), and any 39 | # packages which use webdriver in their R CMD check (in examples or vignettes) 40 | # will get an ERROR. We'll issue a message and return NULL; other 41 | inform(c( 42 | "shinytest requires PhantomJS to record and run tests.", 43 | "To install it, run shinytest::installDependencies()", 44 | "If it is installed, please check it is available on the PATH" 45 | )) 46 | } 47 | return(NULL) 48 | } 49 | path.expand(path) 50 | } 51 | 52 | 53 | 54 | phantom_env <- new.env() 55 | 56 | #' @importFrom webdriver run_phantomjs 57 | 58 | get_phantomPort <- function(timeout = 5000) { 59 | if (! is_phantom_alive()) { 60 | ph <- run_phantomjs(timeout = timeout) 61 | phantom_env$process <- ph$process 62 | phantom_env$port <- ph$port 63 | } 64 | 65 | phantom_env$port 66 | } 67 | 68 | #' @importFrom pingr ping_port 69 | 70 | is_phantom_alive <- function() { 71 | ! is.null(phantom_env$process) && 72 | ! is.null(phantom_env$port) && 73 | ! is.na(ping_port("127.0.0.1", port = phantom_env$port, count = 1)) 74 | } 75 | -------------------------------------------------------------------------------- /R/recorder.R: -------------------------------------------------------------------------------- 1 | #' Launch test event recorder for a Shiny app 2 | #' 3 | #' @param app A [ShinyDriver()] object, or path to a Shiny 4 | #' application. 5 | #' @param save_dir A directory to save stuff. 6 | #' @param load_mode A boolean that determines whether or not the resulting test 7 | #' script should be appropriate for load testing. 8 | #' @param seed A random seed to set before running the app. This seed will also 9 | #' be used in the test script. 10 | #' @param loadTimeout Maximum time to wait for the Shiny application to load, in 11 | #' milliseconds. If a value is provided, it will be saved in the test script. 12 | #' @param debug start the underlying [ShinyDriver()] in `debug` 13 | #' mode and print those debug logs to the R console once recording is 14 | #' finished. The default, `'shiny_console'`, captures and prints R 15 | #' console output from the recorded R shiny process. Any value that the 16 | #' `debug` argument in [ShinyDriver()] accepts may be used 17 | #' (e.g., `'none'` may be used to completely suppress the driver logs). 18 | #' @param shinyOptions A list of options to pass to `runApp()`. If a value 19 | #' is provided, it will be saved in the test script. 20 | #' @export 21 | recordTest <- function(app = ".", save_dir = NULL, load_mode = FALSE, seed = NULL, 22 | loadTimeout = 10000, debug = "shiny_console", shinyOptions = list()) { 23 | 24 | # Get the URL for the app. Depending on what type of object `app` is, it may 25 | # require starting an app. 26 | if (inherits(app, "ShinyDriver")) { 27 | url <- app$getUrl() 28 | } else if (is.character(app)) { 29 | if (grepl("^http(s?)://", app)) { 30 | abort("Recording tests for remote apps is not yet supported.") 31 | } else { 32 | path <- app_path(app, "app")$app 33 | 34 | # Rmds need a random seed 35 | if (is_rmd(path) && is.null(seed)) { 36 | seed <- floor(stats::runif(1, min = 0, max = 1e5)) 37 | } 38 | 39 | app <- ShinyDriver$new(path, seed = seed, loadTimeout = loadTimeout, shinyOptions = shinyOptions) 40 | on.exit({ 41 | rm(app) 42 | gc() 43 | }) 44 | url <- app$getUrl() 45 | } 46 | } else if (inherits(app, "shiny.appobj")) { 47 | abort("Recording tests for shiny.appobj objects is not supported.") 48 | } else { 49 | abort("Unknown object type to record tests for.") 50 | } 51 | 52 | # Create directory if needed 53 | if (is.null(save_dir)) { 54 | save_dir <- findTestsDir(app$getAppDir(), mustExist=FALSE, quiet=FALSE) 55 | if (!dir_exists(save_dir)) { 56 | dir.create(save_dir, recursive=TRUE) 57 | 58 | # findTestsDir would return the nested shinytest/ directory if the dir didn't exist, 59 | # so since we're creating the nested structure, we should leave behind the top- 60 | # level runner, too. 61 | runner <- paste0("library(shinytest)\nshinytest::testApp(\"../\")\n") 62 | writeLines(runner, file.path(save_dir, "..", "shinytest.R")) 63 | } 64 | save_dir <- normalizePath(save_dir) 65 | } 66 | 67 | # Are we running in RStudio? If so, we might need to fix up the URL so that 68 | # it's externally accessible. 69 | if (rstudioapi::isAvailable()) { 70 | if (rstudioapi::hasFun("translateLocalUrl")) { 71 | # If the RStudio API knows how to translate URLs, call it. 72 | url <- rstudioapi::translateLocalUrl(url, absolute = TRUE) 73 | } else if (identical(rstudioapi::versionInfo()$mode, "server")) { 74 | # Older versions of the RStudio API don't know how to translate URLs, so 75 | # we'll need to do it ourselves if we're in server mode. For example, 76 | # http://localhost:1234/ is translated to ../../p/1234/. 77 | url <- paste0("../../p/", gsub(".*:([0-9]+)\\/?", "\\1", url), "/") 78 | } 79 | } 80 | 81 | # Use options to pass value to recorder app 82 | withr::with_options( 83 | list( 84 | shinytest.recorder.url = url, 85 | shinytest.app = app, 86 | shinytest.debug = debug, 87 | shinytest.load.mode = load_mode, 88 | shinytest.load.timeout = if (!missing(loadTimeout)) loadTimeout, 89 | shinytest.seed = seed, 90 | shinytest.shiny.options = shinyOptions 91 | ), 92 | res <- shiny::runApp(system.file("recorder", package = "shinytest")) 93 | ) 94 | 95 | if (is.null(res$appDir)) { 96 | # Quit without saving 97 | 98 | } else if (isTRUE(res$run)) { 99 | 100 | # Before running the test, sometimes we need to make sure the previous run 101 | # of the app is shut down. For example, if a port is specified in 102 | # shinyOptions, it needs to be freed up before starting the app again. 103 | gc() 104 | 105 | # Run the test script 106 | testApp(rel_path(res$appDir), res$file) 107 | 108 | } else { 109 | if (length(res$dont_run_reasons) > 0) { 110 | inform(c("Not running test script because", res$dont_run_reasons)) 111 | } 112 | 113 | inform(sprintf( 114 | 'After making changes to the test script, run it with:\n testApp("%s", "%s")', 115 | rel_path(res$appDir), res$file 116 | )) 117 | } 118 | 119 | invisible(res$file) 120 | } 121 | 122 | 123 | #' Register an input processor for the test recorder 124 | #' 125 | #' @description 126 | #' `registerInputProcessor()` registers an input processor which will be used by 127 | #' the test recorder. The input processor function should take one parameter, 128 | #' `value`, and return a string of R code which returns the desired value. 129 | #' 130 | #' `getInputProcessors()` returns a named list of all registered input processor 131 | #' functions. 132 | #' 133 | #' @param inputType The name of an input type, for example, 134 | #' `"mypkg.numberinput"`. 135 | #' @param processor An input processor function. 136 | #' @export 137 | #' @keywords internal 138 | registerInputProcessor <- function(inputType, processor) { 139 | if (!is.function(processor) || !identical(names(formals(processor)), "value")) { 140 | abort("`processor` must be a function that takes one parameter, `value`") 141 | } 142 | recorder_input_processors[[inputType]] <- processor 143 | } 144 | 145 | #' @rdname registerInputProcessor 146 | #' @export 147 | getInputProcessors <- function() { 148 | as.list(recorder_input_processors) 149 | } 150 | 151 | # This environment holds input processors registered by other packages on load. 152 | recorder_input_processors <- new.env(parent = emptyenv()) 153 | -------------------------------------------------------------------------------- /R/save-app.R: -------------------------------------------------------------------------------- 1 | app_save <- function(app, path = tempfile(), env = parent.frame()) { 2 | if (!is_installed("globals")) { 3 | abort(c( 4 | "globals package required to test app object", 5 | i = "Do you need to run `install.packages('globals')`" 6 | )) 7 | } 8 | 9 | if (!dir.exists(path)) { 10 | dir.create(path) 11 | } 12 | 13 | file.copy( 14 | system.file("app-template.R", package = "shinytest"), 15 | file.path(path, "app.R") 16 | ) 17 | 18 | data <- app_data(app, env) 19 | saveRDS(data, file.path(path, "data.rds")) 20 | 21 | path 22 | } 23 | 24 | # Open questions: 25 | # * what happen if app uses non-exported function? 26 | app_data <- function(app, env = parent.frame()) { 27 | server <- app$serverFuncSource() 28 | globals <- app_server_globals(server, env) 29 | 30 | data <- globals$globals 31 | data$ui <- environment(app$httpHandler)$ui 32 | data$server <- server 33 | data$resources <- shiny::resourcePaths() 34 | data$packages <- globals$packages 35 | data 36 | } 37 | 38 | app_server_globals <- function(server, env = parent.frame()) { 39 | # Work around for https://github.com/HenrikBengtsson/globals/issues/61 40 | env <- new.env(parent = env) 41 | env$output <- NULL 42 | 43 | globals <- globals::globalsOf(server, envir = env, recursive = FALSE) 44 | globals <- globals::cleanup(globals) 45 | 46 | # remove globals found in packages 47 | pkgs <- globals::packagesOf(globals) 48 | in_package <- vapply( 49 | attr(globals, "where"), 50 | function(x) !is.null(attr(x, "name")), 51 | logical(1) 52 | ) 53 | globals <- globals[!in_package] 54 | attributes(globals) <- list(names = names(globals)) 55 | 56 | # https://github.com/HenrikBengtsson/globals/issues/61 57 | globals$output <- NULL 58 | 59 | list( 60 | globals = globals, 61 | packages = pkgs 62 | ) 63 | } 64 | -------------------------------------------------------------------------------- /R/set-inputs.R: -------------------------------------------------------------------------------- 1 | sd_setInputs <- function(self, private, ..., wait_ = TRUE, values_ = TRUE, 2 | timeout_ = 3000, allowInputNoBinding_ = FALSE, priority_ = c("input", "event")) { 3 | if (values_ && !wait_) { 4 | abort(c( 5 | "values_=TRUE and wait_=FALSE are not compatible.", 6 | "Can't return all values without waiting for update." 7 | )) 8 | } 9 | 10 | priority_ <- match.arg(priority_) 11 | 12 | input_values <- lapply(list(...), function(value) { 13 | list( 14 | value = value, 15 | allowInputNoBinding = allowInputNoBinding_, 16 | priority = priority_ 17 | ) 18 | }) 19 | 20 | self$logEvent("Setting inputs", 21 | input = paste(names(input_values), collapse = ",") 22 | ) 23 | 24 | private$queueInputs(input_values) 25 | res <- private$flushInputs(wait_, timeout_) 26 | 27 | if (isTRUE(res$timedOut)) { 28 | # Get the text from one call back, like "app$setInputs(a=1, b=2)" 29 | calls <- sys.calls() 30 | call_text <- deparse(calls[[length(calls) - 1]]) 31 | 32 | inform_where(paste0( 33 | "setInputs(", call_text, "): ", 34 | "Server did not update any output values within ", 35 | format(timeout_/1000, digits = 2), " seconds. ", 36 | "If this is expected, use `wait_=FALSE, values_=FALSE`, or increase the value of timeout_." 37 | )) 38 | } 39 | 40 | self$logEvent("Finished setting inputs", timedout = res$timedOut) 41 | 42 | values <- NULL 43 | if (values_) { 44 | values <- self$getAllValues() 45 | } 46 | 47 | 48 | invisible(values) 49 | } 50 | 51 | 52 | 53 | sd_queueInputs <- function(self, private, inputs) { 54 | assert_that(is_all_named(inputs)) 55 | 56 | private$web$executeScript( 57 | "shinytest.inputQueue.add(arguments[0]);", 58 | inputs 59 | ) 60 | } 61 | 62 | sd_flushInputs <- function(self, private, wait, timeout) { 63 | private$web$executeScriptAsync( 64 | "var wait = arguments[0]; 65 | var timeout = arguments[1]; 66 | var callback = arguments[2]; 67 | shinytest.outputValuesWaiter.start(timeout); 68 | shinytest.inputQueue.flush(); 69 | shinytest.outputValuesWaiter.finish(wait, callback);", 70 | wait, 71 | timeout 72 | ) 73 | } 74 | 75 | sd_uploadFile <- function(self, private, ..., wait_ = TRUE, values_ = TRUE, 76 | timeout_ = 3000) { 77 | if (values_ && !wait_) { 78 | abort(c( 79 | "values_=TRUE and wait_=FALSE are not compatible.", 80 | "Can't return all values without waiting for update." 81 | )) 82 | } 83 | 84 | inputs <- list(...) 85 | if (length(inputs) != 1 || !is_all_named(inputs)) { 86 | abort("Can only upload file to exactly one input, and input must be named") 87 | } 88 | 89 | # Wait for two messages by calling `.start(timeout, 2)`. This is because 90 | # uploading a file will result in two messages before the file is successfully 91 | # uploaded. 92 | private$web$executeScript( 93 | "var timeout = arguments[0]; 94 | shinytest.outputValuesWaiter.start(timeout, 2);", 95 | timeout_ 96 | ) 97 | 98 | self$logEvent("Uploading file", input = inputs[[1]]) 99 | 100 | self$findWidget(names(inputs)[1])$uploadFile(inputs[[1]]) 101 | 102 | res <- private$web$executeScriptAsync( 103 | "var wait = arguments[0]; 104 | var callback = arguments[1]; 105 | shinytest.outputValuesWaiter.finish(wait, callback);", 106 | wait_ 107 | ) 108 | 109 | # Need to wait for the progress bar's CSS transition to complete. The 110 | # transition is 0.6s, so this will ensure that it's done. 111 | Sys.sleep(0.6) 112 | 113 | self$logEvent("Finished uploading file") 114 | 115 | if (values_) 116 | invisible(self$getAllValues()) 117 | else 118 | invisible() 119 | } 120 | -------------------------------------------------------------------------------- /R/shiny-mapping.R: -------------------------------------------------------------------------------- 1 | #' Try to deduce the shiny input/output element type from its name 2 | #' 3 | #' @param name The name of the Shiny input or output to search for. 4 | #' @param iotype It is possible that an input has the same name as 5 | #' an output, and in this case there is no way to get element without 6 | #' knowing whether it is an input or output element. 7 | #' 8 | #' @noRd 9 | sd_findWidget <- function(self, private, name, iotype) { 10 | 11 | "!DEBUG finding a widget `name` (`iotype`)" 12 | 13 | css <- if (iotype == "auto") { 14 | paste0("#", name) 15 | 16 | } else if (iotype == "input") { 17 | paste0("#", name, ".shiny-bound-input") 18 | 19 | } else if (iotype == "output") { 20 | paste0("#", name, ".shiny-bound-output") 21 | } 22 | 23 | els <- self$findElements(css = css) 24 | 25 | if (length(els) == 0) { 26 | abort(paste0( 27 | "Cannot find ", 28 | if (iotype != "auto") paste0(iotype, " "), 29 | "widget ", name 30 | )) 31 | 32 | } else if (length(els) > 1) { 33 | warning( 34 | "Multiple ", 35 | if (iotype != "auto") paste0(iotype, " "), 36 | "widgets with id ", name 37 | ) 38 | } 39 | 40 | type <- els[[1]]$executeScript( 41 | "var el = $(arguments[0]); 42 | if (el.data('shinyInputBinding') !== undefined) { 43 | return ['input', el.data('shinyInputBinding').name]; 44 | } else { 45 | var name = el.data('shinyOutputBinding').binding.name; 46 | if (name == 'shiny.textOutput' && el[0].tagName == 'PRE') { 47 | return ['output', 'shiny.verbatimTextOutput']; 48 | } else { 49 | return ['output', name]; 50 | } 51 | }" 52 | ) 53 | 54 | ## We could use the JS names as well, but it is maybe better to use 55 | ## the names the users encounter with in the Shiny R docs 56 | widget_names <- c( 57 | "shiny.actionButtonInput" = "actionButton", 58 | "shiny.checkboxInput" = "checkboxInput", 59 | "shiny.checkboxGroupInput" = "checkboxGroupInput", 60 | "shiny.dateInput" = "dateInput", 61 | "shiny.dateRangeInput" = "dateRangeInput", 62 | "shiny.fileInputBinding" = "fileInput", 63 | "shiny.numberInput" = "numericInput", 64 | "shiny.radioInput" = "radioButtons", 65 | "shiny.selectInput" = "selectInput", 66 | "shiny.sliderInput" = "sliderInput", 67 | "shiny.textInput" = "textInput", 68 | "shiny.passwordInput" = "passwordInput", 69 | "shiny.bootstrapTabInput" = "tabsetPanel", 70 | 71 | "shiny.textOutput" = "textOutput", 72 | "shiny.verbatimTextOutput" = "verbatimTextOutput", 73 | "shiny.htmlOutput" = "htmlOutput", 74 | "shiny.imageOutput" = "plotOutput", 75 | "datatables" = "tableOutput" 76 | ) 77 | 78 | Widget$new( 79 | name = name, 80 | element = els[[1]], 81 | type = unname(widget_names[type[[2]]] %|NA|% type[[2]]), 82 | iotype = type[[1]] 83 | ) 84 | } 85 | -------------------------------------------------------------------------------- /R/shinytest-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | #' @import rlang 3 | "_PACKAGE" 4 | 5 | # The following block is used by usethis to automatically manage 6 | # roxygen namespace tags. Modify with care! 7 | ## usethis namespace: start 8 | ## usethis namespace: end 9 | NULL 10 | -------------------------------------------------------------------------------- /R/testthat.R: -------------------------------------------------------------------------------- 1 | #' Expectation: `testApp()` passes snapshot tests 2 | #' 3 | #' This returns an testthat expectation object. 4 | #' 5 | #' @param object The results returned by [testApp()]. 6 | #' @param info Extra information to be included in the message (useful when 7 | #' writing tests in loops). 8 | #' 9 | #' @examples 10 | #' \dontrun{ 11 | #' expect_pass(testApp("path/to/app/")) 12 | #' } 13 | #' @export 14 | expect_pass <- function(object, info = NULL) { 15 | if (!inherits(object, "shinytest.results")) { 16 | abort("expect_pass() requires results from shinytest::testApp()") 17 | } 18 | 19 | pass_idx <- vapply(object$results, `[[`, "pass", FUN.VALUE = FALSE) 20 | fail_names <- vapply(object$results[!pass_idx], `[[`, "name", FUN.VALUE = "") 21 | 22 | all_pass <- all(pass_idx) 23 | if (!all_pass) { 24 | diff_txt <- textTestDiff(object$appDir, fail_names, object$images) 25 | message <- sprintf( 26 | "Not all shinytest scripts passed for %s: %s\n\nDiff output:\n%s\n%s", 27 | object$appDir, 28 | paste(fail_names, collapse = ", "), 29 | diff_txt, 30 | paste0("If this is expected, use `snapshotUpdate('", object$appDir, "')` to update") 31 | ) 32 | } else { 33 | message <- "" 34 | } 35 | 36 | testthat::expect(all_pass, message, info = info) 37 | invisible(object) 38 | } 39 | -------------------------------------------------------------------------------- /R/widget.R: -------------------------------------------------------------------------------- 1 | #' A Shiny Widget 2 | #' 3 | #' @description 4 | #' A `Widget` object represents a Shiny input or output control, and provides 5 | #' methods for finer grained interaction. 6 | #' 7 | #' @importFrom R6 R6Class 8 | Widget <- R6Class( 9 | "Widget", 10 | private = list( 11 | name = NULL, # name in shiny 12 | element = NULL, # HTML element with name as id 13 | type = NULL, # e.g. selectInput 14 | iotype = NULL # "input" or "output" 15 | ), 16 | public = list( 17 | #' @description Create new `Widget` 18 | #' @param name Name of a Shiny widget. 19 | #' @param element [webdriver::Element] 20 | #' @param type Widget type 21 | #' @param iotype Input/output type. 22 | initialize = function(name, element, type, iotype = c("input", "output")) { 23 | iotype <- match.arg(iotype) 24 | 25 | private$name <- name 26 | private$element <- element 27 | private$type <- type 28 | private$iotype <- iotype 29 | invisible(self) 30 | }, 31 | 32 | #' @description Control id (i.e. `inputId` or `outputId` that control 33 | #' was created with). 34 | getName = function() private$name, 35 | #' @description Underlying [webdriver::Element()] object. 36 | getElement = function() private$element, 37 | #' @description retrieve the underlying HTML for a widget 38 | getHtml = function() { 39 | private$element$executeScript("return arguments[0].outerHTML;") 40 | }, 41 | #' @description Widget type, e.g. `textInput`, `selectInput`. 42 | getType = function() private$type, 43 | #' @description Is this an input or output control? 44 | getIoType = function() private$iotype, 45 | #' @description Is this an input control? 46 | isInput = function() private$iotype == "input", 47 | #' @description Is this an output control? 48 | isOutput = function() private$iotype == "output", 49 | 50 | #' @description Get current value of control. 51 | getValue = function(){ 52 | "!DEBUG widget_getValue `private$name`" 53 | 54 | if (private$iotype == "input") { 55 | res <- private$element$executeScript( 56 | "var el = $(arguments[0]); 57 | return el.data('shinyInputBinding').getValue(el[0]);" 58 | ) 59 | } else { 60 | res <- switch(private$type, 61 | htmlOutput = private$element$executeScript("return $(arguments[0]).html();"), 62 | verbatimTextOutput = private$element$getText(), 63 | textOutput = private$element$getText(), 64 | abort(paste0("getValue is not implemented for ", private$type)) 65 | ) 66 | } 67 | 68 | # Post-process, if needed 69 | res <- switch(private$type, 70 | checkboxGroupInput = as.character(unlist(res)), 71 | dateInput = as.Date(res), 72 | dateRangeInput = as.Date(unlist(res)), 73 | sliderInput = as.numeric(unlist(res)), 74 | res 75 | ) 76 | 77 | res 78 | }, 79 | 80 | #' @description Set value of control. 81 | #' @param value Value to set for the widget. 82 | setValue = function(value) { 83 | "!DEBUG widget_setValue `private$name`" 84 | if (private$iotype == "output") { 85 | abort("Cannot set values of output widgets") 86 | } 87 | 88 | # Preprocess value 89 | value <- switch(private$type, 90 | dateRangeInput = list(start = value[1], end = value[2]), 91 | radioButtons = if (!is.null(value)) as.character(value), 92 | value 93 | ) 94 | 95 | setValueScript <-" 96 | var el = $(arguments[0]); 97 | var val = arguments[1]; 98 | el.data('shinyInputBinding').setValue(el[0], val); 99 | el.trigger('change'); 100 | " 101 | private$element$executeScript(setValueScript, value) 102 | 103 | invisible(self) 104 | }, 105 | 106 | #' @description scrolls the element into view, then clicks the in-view 107 | #' centre point of it. 108 | #' @return self, invisibly. 109 | click = function() { 110 | private$element$click() 111 | invisible(self) 112 | }, 113 | 114 | #' @description Send specified key presses to control. 115 | #' @param keys Keys to send to the widget or the app. See [webdriver::key] 116 | #' for how to specific special keys. 117 | sendKeys = function(keys) { 118 | "!DEBUG widget_sendKeys `private$name`" 119 | private$element$sendKeys(keys) 120 | }, 121 | 122 | #' @description Lists the tab names of a [shiny::tabsetPanel()]. 123 | #' It fails for other types of widgets. 124 | listTabs = function() { 125 | if (private$type != "tabsetPanel") { 126 | abort("'listTabs' only works for 'tabsetPanel' Widgets") 127 | } 128 | tabs <- private$element$findElements("li a") 129 | vapply(tabs, function(t) t$getData("value"), "") 130 | }, 131 | 132 | #' @description Upload a file to a [shiny::fileInput()]. 133 | #' It fails for other types of widgets. 134 | #' @param filename Path to file to upload 135 | uploadFile = function(filename) { 136 | private$element$uploadFile(filename = filename) 137 | } 138 | ) 139 | ) 140 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # shinytest 2 | 3 | 4 | [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/shinytest)](https://www.r-pkg.org/pkg/shinytest) 5 | [![R build status](https://github.com/rstudio/shinytest/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/rstudio/shinytest/actions) 6 | 7 | 8 | NOTE: **shinytest is deprecated** and may not work with Shiny after version 1.8.1, which was released on 2024-04-02. This is because it is based on a headless browser, PhantomJS, which was last released on 2016-01-24 and is no longer being developed. Going forward, please use [shinytest2](https://github.com/rstudio/shinytest2), which makes use of headless Chromium-based browsers. See the [shinytest to shinytest2 Migration Guide](https://rstudio.github.io/shinytest2/articles/z-migration.html) for more information. 9 | 10 | shinytest provides a simulation of a Shiny app that you can control in order to automate testing. shinytest uses a snapshot-based testing strategy: the first time it runs a set of tests for an application, it performs some scripted interactions with the app and takes one or more snapshots of the application’s state. Subsequent runs perform the same scripted interactions then compare the results; you'll get an error if they're different. 11 | 12 | ## Installation 13 | 14 | To install the current release version: 15 | 16 | 17 | ```r 18 | install.packages("shinytest") 19 | ``` 20 | 21 | ## Usage 22 | 23 | See the [getting started guide](https://rstudio.github.io/shinytest/articles/shinytest.html) to learn how to use shinytest. 24 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://rstudio.github.io/shinytest 2 | 3 | # Do not display dev docs on main website 4 | # Dev website: https://rstudio.github.io/shinytest/dev/ 5 | development: 6 | mode: auto 7 | 8 | template: 9 | params: 10 | docsearch: 11 | api_key: '7030758f1dfae4baea1a66de46029355' 12 | index_name: 'shinytest' 13 | 14 | reference: 15 | - title: Record and replay tests 16 | contents: 17 | - recordTest 18 | - testApp 19 | - migrateShinytestDir 20 | - expect_pass 21 | - osName 22 | 23 | - title: Remote control 24 | contents: 25 | - Widget 26 | - ShinyDriver 27 | 28 | - title: Dependencies 29 | contents: 30 | - installDependencies 31 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Comments 2 | 3 | #### 2021-08-19 4 | 5 | Bug fixes. 6 | 7 | I have removed the `LazyData` field in the DESCRIPTION to address the NOTE: 8 | ``` 9 | Check: LazyData 10 | Result: NOTE 11 | 'LazyData' is specified without a 'data' directory 12 | ``` 13 | 14 | Thank you, 15 | Winston 16 | 17 | 18 | ## Test environments and R CMD check results 19 | 20 | * GitHub Actions - https://github.com/rstudio/shinytest/pull/404/checks 21 | * macOS 22 | * devel, release 23 | * windows 24 | * release, 3.6 25 | * ubuntu20 26 | * devel, release, oldrel/1, oldrel/2, oldrel/3, oldrel/4 27 | * devtools:: 28 | * check_win_devel() 29 | * check_win_release() 30 | * check_win_oldrelease() 31 | 32 | 0 errors ✔ | 0 warnings ✔ | 0 notes ✔ 33 | 34 | 35 | ## revdepcheck results 36 | 37 | We checked 31 reverse dependencies (30 from CRAN + 1 from BioConductor), comparing R CMD check results across CRAN and dev versions of this package. 38 | 39 | * We saw 0 new problems 40 | * We failed to check 0 packages 41 | -------------------------------------------------------------------------------- /inst/app-template.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | `_data` <- readRDS('data.rds') 3 | 4 | lapply(`_data`$packages, library, character.only = TRUE) 5 | for (prefix in names(`_data`$resources)) { 6 | shiny::addResourcePath(prefix, `_data`$resources[[prefix]]) 7 | } 8 | 9 | shinyApp(`_data`$ui, `_data`$server) 10 | -------------------------------------------------------------------------------- /inst/diffviewerapp/app.R: -------------------------------------------------------------------------------- 1 | app_dir <- getOption("shinytest.app.dir") 2 | test_name <- getOption("shinytest.test.name") 3 | suffix <- getOption("shinytest.suffix") 4 | 5 | msg_suffix <- shinytest:::normalize_suffix(suffix) 6 | 7 | shinyApp( 8 | ui = bootstrapPage( 9 | tags$head( 10 | tags$link(rel = "stylesheet", type = "text/css", href = "diffviewerapp.css") 11 | ), 12 | div(class = "header", 13 | div(class = "title", 14 | paste0( 15 | "Differences between expected", msg_suffix, 16 | " (old) and current (new) test results for ", 17 | basename(app_dir), ": ", test_name 18 | ) 19 | ), 20 | div(class = "controls", 21 | actionLink("accept", 22 | span( 23 | img(src = "exit-save.png", class = "diffviewer-icon"), 24 | "Update and quit", 25 | title = paste0( 26 | "Replace the expected", msg_suffix, " results with the current results" 27 | ) 28 | ) 29 | ), 30 | actionLink("reject", 31 | span( 32 | img(src = "exit-nosave.png", class = "diffviewer-icon"), 33 | "Quit", 34 | title = paste0("Leave the expected", msg_suffix, " results unchanged") 35 | ) 36 | ) 37 | ) 38 | ), 39 | div( 40 | class = "content", 41 | shinytest::viewTestDiffWidget(app_dir, test_name, suffix) 42 | ) 43 | ), 44 | 45 | server = function(input, output) { 46 | observeEvent(input$accept, { 47 | shinytest::snapshotUpdate(app_dir, test_name, suffix = suffix) 48 | stopApp("accept") 49 | }) 50 | 51 | observeEvent(input$reject, { 52 | stopApp("reject") 53 | }) 54 | 55 | onSessionEnded(function() { 56 | # Quit the app if the user closes the window 57 | stopApp("reject") 58 | }) 59 | } 60 | ) 61 | -------------------------------------------------------------------------------- /inst/diffviewerapp/www/diffviewerapp.css: -------------------------------------------------------------------------------- 1 | body { 2 | position: fixed; 3 | top: 0; 4 | left: 0; 5 | bottom: 0; 6 | right: 0; 7 | display: -webkit-flex; 8 | display: -ms-flexbox; 9 | display: flex; 10 | -webkit-flex-flow: column; 11 | flex-flow: column; 12 | } 13 | 14 | .header { 15 | background: #f6f7f9; 16 | padding: 0; 17 | border-bottom: 1px solid #d6dadd; 18 | -webkit-flex: 0 0 auto; /* Needed for QT webkit and old versions of Safari */ 19 | } 20 | 21 | .header > .title { 22 | padding: 3px 10px; 23 | font-size: 15px; 24 | font-weight: bold; 25 | background: #d6dadd; 26 | } 27 | 28 | .header > .controls { 29 | padding: 8px 10px; 30 | } 31 | 32 | .header > .controls a.action-button, 33 | .header > .controls a.action-button:visited, 34 | .header > .controls a.action-button:hover { 35 | margin: 0 8px; 36 | text-decoration: none; 37 | color: #000; 38 | } 39 | 40 | 41 | .content { 42 | -webkit-flex-grow: 1; 43 | flex-grow: 1; 44 | overflow-y: scroll; 45 | padding: 0 10px; 46 | } 47 | 48 | .diffviewer-icon { 49 | width: 20px; 50 | height: 18px; 51 | margin-right: 4px; 52 | vertical-align: bottom; 53 | } 54 | -------------------------------------------------------------------------------- /inst/diffviewerapp/www/exit-nosave.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/inst/diffviewerapp/www/exit-nosave.png -------------------------------------------------------------------------------- /inst/diffviewerapp/www/exit-save.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/inst/diffviewerapp/www/exit-save.png -------------------------------------------------------------------------------- /inst/htmlwidgets/diffviewer.yaml: -------------------------------------------------------------------------------- 1 | dependencies: 2 | - name: jquery 3 | version: 1.12.4 4 | src: "htmlwidgets/lib/jquery" 5 | script: 6 | - jquery.min.js 7 | - name: diff2html 8 | version: 2.3.0 9 | src: "htmlwidgets/lib/diff2html" 10 | script: 11 | - diff2html.min.js 12 | - diff2html-ui.min.js 13 | stylesheet: 14 | - diff2html.min.css 15 | - name: jsdiff 16 | version: 3.2.0 17 | src: "htmlwidgets/lib/jsdiff" 18 | script: 19 | - diff.js 20 | - name: resemble 21 | version: 2.2.4 22 | src: "htmlwidgets/lib/resemble" 23 | script: 24 | - resemble.js 25 | - name: diffviewer-styles 26 | version: 0.1 27 | src: htmlwidgets/lib/diffviewer 28 | stylesheet: diffviewer.css 29 | -------------------------------------------------------------------------------- /inst/htmlwidgets/lib/diff2html/diff2html-ui.min.js: -------------------------------------------------------------------------------- 1 | !function e(t,n,r){function s(o,u){if(!n[o]){if(!t[o]){var a="function"==typeof require&&require;if(!u&&a)return a(o,!0);if(i)return i(o,!0);var f=new Error("Cannot find module '"+o+"'");throw f.code="MODULE_NOT_FOUND",f}var l=n[o]={exports:{}};t[o][0].call(l.exports,function(e){var n=t[o][1][e];return s(n?n:e)},l,l.exports,e,t,n,r)}return n[o].exports}for(var i="function"==typeof require&&require,o=0;o/gm,">")}function tag(node){return node.nodeName.toLowerCase()}var ArrayProto=[];HighlightJS.prototype.nodeStream=function(node){var result=[];return function _nodeStream(node,offset){for(var child=node.firstChild;child;child=child.nextSibling)3===child.nodeType?offset+=child.nodeValue.length:1===child.nodeType&&(result.push({event:"start",offset:offset,node:child}),offset=_nodeStream(child,offset),tag(child).match(/br|hr|img|input/)||result.push({event:"stop",offset:offset,node:child}));return offset}(node,0),result},HighlightJS.prototype.mergeStreams=function(original,highlighted,value){function selectStream(){return original.length&&highlighted.length?original[0].offset!==highlighted[0].offset?original[0].offset"}function close(node){result+=""}function render(event){("start"===event.event?open:close)(event.node)}for(var processed=0,result="",nodeStack=[];original.length||highlighted.length;){var stream=selectStream();if(result+=escape(value.substring(processed,stream[0].offset)),processed=stream[0].offset,stream===original){nodeStack.reverse().forEach(close);do render(stream.splice(0,1)[0]),stream=selectStream();while(stream===original&&stream.length&&stream[0].offset===processed);nodeStack.reverse().forEach(open)}else"start"===stream[0].event?nodeStack.push(stream[0].node):nodeStack.pop(),render(stream.splice(0,1)[0])}return result+escape(value.substr(processed))},module.exports.HighlightJS=new HighlightJS}()},{}]},{},[1]); -------------------------------------------------------------------------------- /inst/htmlwidgets/lib/diff2html/diff2html.min.css: -------------------------------------------------------------------------------- 1 | .d2h-wrapper{text-align:left}.d2h-file-header{padding:5px 10px;border-bottom:1px solid #d8d8d8;background-color:#f7f7f7}.d2h-file-stats{display:-webkit-box;display:-ms-flexbox;display:flex;margin-left:auto;font-size:14px}.d2h-lines-added{text-align:right;border:1px solid #b4e2b4;border-radius:5px 0 0 5px;color:#399839;padding:2px;vertical-align:middle}.d2h-lines-deleted{text-align:left;border:1px solid #e9aeae;border-radius:0 5px 5px 0;color:#c33;padding:2px;vertical-align:middle;margin-left:1px}.d2h-file-name-wrapper{display:-webkit-box;display:-ms-flexbox;display:flex;-webkit-box-align:center;-ms-flex-align:center;align-items:center;width:100%;font-family:"Source Sans Pro","Helvetica Neue",Helvetica,Arial,sans-serif;font-size:15px}.d2h-file-name{white-space:nowrap;text-overflow:ellipsis;overflow-x:hidden;line-height:21px}.d2h-file-wrapper{border:1px solid #ddd;border-radius:3px;margin-bottom:1em}.d2h-diff-table{width:100%;border-collapse:collapse;font-family:Menlo,Consolas,monospace;font-size:13px}.d2h-diff-tbody>tr>td{height:20px;line-height:20px}.d2h-files-diff{display:block;width:100%;height:100%}.d2h-file-diff{overflow-x:scroll;overflow-y:hidden}.d2h-file-side-diff{display:inline-block;overflow-x:scroll;overflow-y:hidden;width:50%;margin-right:-4px;margin-bottom:-8px}.d2h-code-line{display:inline-block;white-space:nowrap;padding:0 10px;margin-left:80px}.d2h-code-side-line{display:inline-block;white-space:nowrap;padding:0 10px;margin-left:50px}.d2h-code-line del,.d2h-code-side-line del{display:inline-block;margin-top:-1px;text-decoration:none;background-color:#ffb6ba;border-radius:.2em}.d2h-code-line ins,.d2h-code-side-line ins{display:inline-block;margin-top:-1px;text-decoration:none;background-color:#97f295;border-radius:.2em;text-align:left}.d2h-code-line-prefix{display:inline;background:0 0;padding:0;word-wrap:normal;white-space:pre}.d2h-code-line-ctn{display:inline;background:0 0;padding:0;word-wrap:normal;white-space:pre}.line-num1{box-sizing:border-box;float:left;width:40px;overflow:hidden;text-overflow:ellipsis;padding-left:3px}.line-num2{box-sizing:border-box;float:right;width:40px;overflow:hidden;text-overflow:ellipsis;padding-left:3px}.d2h-code-linenumber{box-sizing:border-box;position:absolute;width:86px;padding-left:2px;padding-right:2px;background-color:#fff;color:rgba(0,0,0,.3);text-align:right;border:solid #eee;border-width:0 1px 0 1px;cursor:pointer}.d2h-code-side-linenumber{box-sizing:border-box;position:absolute;width:56px;padding-left:5px;padding-right:5px;background-color:#fff;color:rgba(0,0,0,.3);text-align:right;border:solid #eee;border-width:0 1px 0 1px;cursor:pointer;overflow:hidden;text-overflow:ellipsis}.d2h-del{background-color:#fee8e9;border-color:#e9aeae}.d2h-ins{background-color:#dfd;border-color:#b4e2b4}.d2h-info{background-color:#f8fafd;color:rgba(0,0,0,.3);border-color:#d5e4f2}.d2h-file-diff .d2h-del.d2h-change{background-color:#fdf2d0}.d2h-file-diff .d2h-ins.d2h-change{background-color:#ded}.d2h-file-list-wrapper{margin-bottom:10px}.d2h-file-list-wrapper a{text-decoration:none;color:#3572b0}.d2h-file-list-wrapper a:visited{color:#3572b0}.d2h-file-list-header{text-align:left}.d2h-file-list-title{font-weight:700}.d2h-file-list-line{display:-webkit-box;display:-ms-flexbox;display:flex;text-align:left}.d2h-file-list{display:block;list-style:none;padding:0;margin:0}.d2h-file-list>li{border-bottom:#ddd solid 1px;padding:5px 10px;margin:0}.d2h-file-list>li:last-child{border-bottom:none}.d2h-file-switch{display:none;font-size:10px;cursor:pointer}.d2h-icon-wrapper{line-height:31px}.d2h-icon{vertical-align:middle;margin-right:10px;fill:currentColor}.d2h-deleted{color:#c33}.d2h-added{color:#399839}.d2h-changed{color:#d0b44c}.d2h-moved{color:#3572b0}.d2h-tag{display:-webkit-box;display:-ms-flexbox;display:flex;font-size:10px;margin-left:5px;padding:0 2px;background-color:#fff}.d2h-deleted-tag{border:#c33 1px solid}.d2h-added-tag{border:#399839 1px solid}.d2h-changed-tag{border:#d0b44c 1px solid}.d2h-moved-tag{border:#3572b0 1px solid}.selecting-left .d2h-code-line,.selecting-left .d2h-code-line *,.selecting-left .d2h-code-side-line,.selecting-left .d2h-code-side-line *,.selecting-right td.d2h-code-linenumber,.selecting-right td.d2h-code-linenumber *,.selecting-right td.d2h-code-side-linenumber,.selecting-right td.d2h-code-side-linenumber *{-webkit-touch-callout:none;-webkit-user-select:none;-moz-user-select:none;-ms-user-select:none;user-select:none}.selecting-left .d2h-code-line ::-moz-selection,.selecting-left .d2h-code-line::-moz-selection,.selecting-left .d2h-code-side-line ::-moz-selection,.selecting-left .d2h-code-side-line::-moz-selection,.selecting-right td.d2h-code-linenumber::-moz-selection,.selecting-right td.d2h-code-side-linenumber ::-moz-selection,.selecting-right td.d2h-code-side-linenumber::-moz-selection{background:0 0}.selecting-left .d2h-code-line ::selection,.selecting-left .d2h-code-line::selection,.selecting-left .d2h-code-side-line ::selection,.selecting-left .d2h-code-side-line::selection,.selecting-right td.d2h-code-linenumber::selection,.selecting-right td.d2h-code-side-linenumber ::selection,.selecting-right td.d2h-code-side-linenumber::selection{background:0 0} -------------------------------------------------------------------------------- /inst/htmlwidgets/lib/resemble/README.md: -------------------------------------------------------------------------------- 1 | This directory contains the resemble.js library from https://github.com/Huddle/Resemble.js, with the following change: 2 | 3 | It adds the field `data.dims`, which contains the height and width for both files. This is used by the diffviewer to set the sizes of the images, before the images are loaded, so that there isn't any flicker from images resizing after they've been loaded. 4 | -------------------------------------------------------------------------------- /inst/recorder/recorder.js: -------------------------------------------------------------------------------- 1 | // The content of this file gets injected into the Shiny application that is 2 | // in the iframe. This is the application for which interactions are being 3 | // recorded. 4 | 5 | window.shinyRecorder = (function() { 6 | var shinyrecorder = { 7 | initialized: false, 8 | token: null // Gets set by parent frame 9 | }; 10 | 11 | // Store previous values for each input. Use JSON so that we can compare 12 | // non-primitive objects like arrays. 13 | var previousInputValues = {}; 14 | 15 | // Some inputs are changed from the server (via updateTextInput and 16 | // similar), but we don't want to record these inputs. This keeps track of 17 | // inputs that were updated this way. 18 | var updatedInputs = {}; 19 | 20 | // When the client receives output values from the server, it's possible 21 | // for an html output to contain a Shiny input, with some default value. 22 | // In that case, we don't want to record the input event, because it's 23 | // automatic. When this happens, it will trigger a shiny:inputchanged 24 | // event on the same tick. 25 | var waitingForInputChange = false; 26 | 27 | $(document).on("shiny:inputchanged", function(event) { 28 | // If the value has been set via a shiny:updateInput event, we want to 29 | // ignore it. To do this, we'll add it to the previous values list. 30 | // For some inputs (like sliders), when a value is updated, it can 31 | // result in shiny:inputchanged getting triggered more than once, so 32 | // we need to make sure that we ignore it this time and future times. 33 | if (updatedInputs[event.name]) { 34 | previousInputValues[event.name] = JSON.stringify(event.value); 35 | delete updatedInputs[event.name]; 36 | return; 37 | } 38 | 39 | // If this input change was triggered by an html output, don't record 40 | // it. 41 | if (waitingForInputChange) { 42 | previousInputValues[event.name] = JSON.stringify(event.value); 43 | delete updatedInputs[event.name]; 44 | return; 45 | } 46 | 47 | // Check if value has changed from last time. 48 | if (event.priority !== "event") { 49 | var valueJSON = JSON.stringify(event.value); 50 | if (valueJSON === previousInputValues[event.name]) 51 | return; 52 | previousInputValues[event.name] = valueJSON; 53 | } 54 | 55 | var hasBinding = !!event.binding; 56 | sendInputEventToParent(event.inputType, event.name, event.value, hasBinding, event.priority); 57 | }); 58 | 59 | $(document).on("shiny:filedownload", function(event) { 60 | sendFileDownloadEventToParent(event.name); 61 | }); 62 | 63 | $(document).on("shiny:value", function(event) { 64 | // For now, we only care _that_ outputs have changed, but not what 65 | // they are. 66 | sendOutputEventToParentDebounced(); 67 | 68 | // This is used to detect if any output updates trigger an input 69 | // change. 70 | waitingForInputChange = true; 71 | setTimeout(function() { waitingForInputChange = false; }, 0); 72 | }); 73 | 74 | // Register input updates here and ignore them in the shiny:inputchanged 75 | // listener. 76 | $(document).on("shiny:updateinput", function(event) { 77 | var inputId = event.binding.getId(event.target); 78 | updatedInputs[inputId] = true; 79 | // Schedule this updated input to be cleared at the end of this tick. 80 | // This is useful in the case where an input is updated with an empty 81 | // value -- for example, if a selectInput is updated with a number of 82 | // selections and a value of character(0), then it will not be removed 83 | // from the updatedInputs list via the other code paths. (Note that it 84 | // is possible in principle for other functions to be scheduled to 85 | // occur afterward, but on the same tick, but in practice this 86 | // shouldn't occur.) 87 | setTimeout(function() { delete updatedInputs[inputId]; }, 0); 88 | }); 89 | 90 | // Ctrl-click or Cmd-click (Mac) to record an output value 91 | $(document).on("click", ".shiny-bound-output", function(e) { 92 | if (!(e.ctrlKey || e.metaKey)) 93 | return; 94 | 95 | var $el = $(e.target).closest(".shiny-bound-output"); 96 | if ($el.length == 0) 97 | return; 98 | 99 | sendOutputSnapshotToParent($el[0].id); 100 | }); 101 | 102 | // Trigger a snapshot on Ctrl-shift-S or Cmd-shift-S (Mac) 103 | $(document).keydown(function(e) { 104 | if (!(e.ctrlKey || e.metaKey)) 105 | return; 106 | if (!e.shiftKey) 107 | return; 108 | if (e.which !== 83) 109 | return; 110 | 111 | sendSnapshotToParent(); 112 | }); 113 | 114 | function debounce(f, delay) { 115 | var timer = null; 116 | return function() { 117 | var context = this; 118 | var args = arguments; 119 | clearTimeout(timer); 120 | timer = setTimeout(function () { 121 | f.apply(context, args); 122 | }, delay); 123 | }; 124 | } 125 | 126 | function sendInputEventToParent(inputType, name, value, hasBinding, priority) { 127 | parent.postMessage({ 128 | token: shinyrecorder.token, 129 | inputEvent: { 130 | inputType: inputType, 131 | name: name, 132 | value: value, 133 | hasBinding: hasBinding, 134 | priority: priority 135 | } 136 | }, "*"); 137 | } 138 | 139 | function sendFileDownloadEventToParent(name, url) { 140 | parent.postMessage({ 141 | token: shinyrecorder.token, 142 | fileDownload: { name: name } 143 | }, "*"); 144 | } 145 | 146 | function sendOutputEventToParent() { 147 | parent.postMessage({ 148 | token: shinyrecorder.token, 149 | outputEvent: {} 150 | }, "*"); 151 | } 152 | 153 | // If multiple outputs are updated in a single reactive flush, the JS 154 | // output events will all happen in a single tick. Debouncing for one tick 155 | // will collapse them into a single call to sendOutputEventToParent(). 156 | var sendOutputEventToParentDebounced = debounce(sendOutputEventToParent, 10); 157 | 158 | function sendSnapshotToParent() { 159 | parent.postMessage({ 160 | token: shinyrecorder.token, 161 | snapshotKeypress: true 162 | }, "*"); 163 | } 164 | 165 | function sendOutputSnapshotToParent(name) { 166 | parent.postMessage({ 167 | token: shinyrecorder.token, 168 | outputSnapshot: { name: name } 169 | }, "*"); 170 | } 171 | 172 | 173 | // ------------------------------------------------------------------------ 174 | // Initialization 175 | // ------------------------------------------------------------------------ 176 | function initialize() { 177 | if (shinyrecorder.initialized) 178 | return; 179 | 180 | // Save initial values so we can check for changes. 181 | for (var name in Shiny.shinyapp.$inputValues) { 182 | if (Shiny.shinyapp.$inputValues.hasOwnProperty(name)) { 183 | previousInputValues[name] = JSON.stringify(Shiny.shinyapp.$inputValues[name]); 184 | } 185 | } 186 | 187 | shinyrecorder.initialized = true; 188 | } 189 | if (Shiny && Shiny.shinyapp && Shiny.shinyapp.isConnected()) { 190 | initialize(); 191 | } else { 192 | $(document).on("shiny:connected", initialize); 193 | } 194 | 195 | 196 | return shinyrecorder; 197 | })(); 198 | -------------------------------------------------------------------------------- /inst/recorder/www/exit-nosave.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/inst/recorder/www/exit-nosave.png -------------------------------------------------------------------------------- /inst/recorder/www/exit-save.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/inst/recorder/www/exit-save.png -------------------------------------------------------------------------------- /inst/recorder/www/recorder.css: -------------------------------------------------------------------------------- 1 | html,body { 2 | font-size: 12px; 3 | width: 100%; 4 | height:100%; 5 | font-family: "Lucida Sans", "DejaVu Sans", "Lucida Grande", "Segoe UI", 6 | Verdana, Helvetica, sans-serif; 7 | } 8 | 9 | #app-iframe-container { 10 | border: none; 11 | position: fixed; 12 | left: 0; 13 | top: 0; 14 | bottom: 0; 15 | right: 300px; 16 | } 17 | 18 | #app-iframe { 19 | border: 0px; 20 | border-right: solid 1px #d6dadc; 21 | width: 100%; 22 | height: 100%; 23 | } 24 | 25 | #shiny-recorder { 26 | border: none; 27 | position: fixed; 28 | width: 300px; 29 | top: 0; 30 | bottom: 0; 31 | right: 0; 32 | display: -webkit-flex; 33 | display: -ms-flexbox; 34 | display: flex; 35 | -webkit-flex-flow: column; 36 | flex-flow: column; 37 | } 38 | 39 | #shiny-recorder .shiny-recorder-header { 40 | -webkit-flex: 0 0 auto; /* Needed for QT webkit and old versions of Safari */ 41 | font-size: 11px; 42 | color: #000; 43 | background: #d6dadd; 44 | font-weight: bold; 45 | padding: 5px 10px; 46 | } 47 | 48 | #shiny-recorder .shiny-recorder-controls { 49 | -webkit-flex: 0 0 auto; /* Needed for QT webkit and old versions of Safari */ 50 | padding: 10px; 51 | background: #f6f7f9; 52 | } 53 | 54 | #shiny-recorder hr { 55 | margin: 12px 0; 56 | border-top: 1px solid #b6babc; 57 | } 58 | 59 | #shiny-recorder .shiny-recorder-icon { 60 | width: 20px; 61 | height: 18px; 62 | margin-right: 4px; 63 | vertical-align: bottom; 64 | } 65 | 66 | #shiny-recorder a.action-button, 67 | #shiny-recorder a.action-button:visited, 68 | #shiny-recorder a.action-button:hover { 69 | display: block; 70 | margin: 10px 0; 71 | text-decoration: none; 72 | color: #000; 73 | height: 18px; 74 | } 75 | 76 | /* Snapshot button needs no margin on top. Need double qualifier for CSS rule 77 | to override previous one. */ 78 | #shiny-recorder #snapshot { 79 | margin-top: 0; 80 | } 81 | 82 | #shiny-recorder .form-group { 83 | margin: 10px 0; 84 | } 85 | 86 | #shiny-recorder .form-group label { 87 | font-weight: normal; 88 | } 89 | 90 | #shiny-recorder .form-group > label { 91 | margin-left: 3px; 92 | margin-bottom: 3px; 93 | } 94 | 95 | 96 | 97 | /* Need to override Bootstrap styling. */ 98 | #shiny-recorder input[type="text"], #shiny-recorder input[type="number"] { 99 | border-radius: 0; 100 | font-size: 11px; 101 | height: inherit; 102 | padding: 2px 4px; 103 | border: 1px solid #999; 104 | } 105 | 106 | /* Bring the two checkboxes closer together. */ 107 | #shiny-recorder .form-group .checkbox { 108 | margin-bottom: -10px; 109 | } 110 | 111 | 112 | #recorded-events { 113 | -webkit-flex-grow: 1; 114 | flex-grow: 1; 115 | overflow-y: scroll; 116 | } 117 | 118 | #shiny-recorder .table { 119 | 120 | } 121 | 122 | #shiny-recorder .table thead { 123 | } 124 | 125 | #shiny-recorder .table thead > tr > th { 126 | padding-left: 10px; 127 | font-weight: normal; 128 | background: #eeeff1; 129 | border-top: 1px solid #f7f8f9; 130 | border-right: 1px solid #d6dadd; 131 | border-bottom: 1px solid #d6dadd; 132 | border-left: 1px solid #f7f8f9; 133 | } 134 | 135 | #shiny-recorder .table thead > tr > th:nth-child(1) { 136 | border-right: none; 137 | } 138 | #shiny-recorder .table thead > tr > th:nth-child(2) { 139 | border-left: none; 140 | } 141 | #shiny-recorder .table thead > tr > th:nth-child(3) { 142 | border-right: none; 143 | } 144 | 145 | #shiny-recorder .table tbody > tr > td { 146 | padding-top: 3px; 147 | padding-bottom: 3px; 148 | border-top: none; 149 | } 150 | -------------------------------------------------------------------------------- /inst/recorder/www/snapshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/inst/recorder/www/snapshot.png -------------------------------------------------------------------------------- /man/diffviewer_widget.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/view-diff.R 3 | \name{diffviewer_widget} 4 | \alias{diffviewer_widget} 5 | \title{Creat an htmlwidget that shows differences between files or directories} 6 | \usage{ 7 | diffviewer_widget(old, new, width = NULL, height = NULL, pattern = NULL) 8 | } 9 | \arguments{ 10 | \item{old, new}{Names of the old and new directories to compare. 11 | Alternatively, they can be a character vectors of specific files to 12 | compare.} 13 | 14 | \item{width}{Width of the htmlwidget.} 15 | 16 | \item{height}{Height of the htmlwidget} 17 | 18 | \item{pattern}{A filter to apply to the old and new directories.} 19 | } 20 | \description{ 21 | This function can be used for viewing differences between current test 22 | results and the expected results 23 | } 24 | \keyword{internal} 25 | -------------------------------------------------------------------------------- /man/expectUpdate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/expect.R 3 | \name{expectUpdate} 4 | \alias{expectUpdate} 5 | \title{\code{testthat} expectation for a Shiny update} 6 | \usage{ 7 | expectUpdate( 8 | app, 9 | output, 10 | ..., 11 | timeout = 3000, 12 | iotype = c("auto", "input", "output") 13 | ) 14 | } 15 | \arguments{ 16 | \item{app}{A \code{\link[=ShinyDriver]{ShinyDriver()}} object.} 17 | 18 | \item{output}{Character vector, the name(s) of the output widgets 19 | that are required to update for the test to succeed.} 20 | 21 | \item{...}{Named arguments specifying updates for Shiny input 22 | widgets.} 23 | 24 | \item{timeout}{Timeout for the update to happen, in milliseconds.} 25 | 26 | \item{iotype}{Type of the widget(s) to change. These are normally 27 | input widgets.} 28 | } 29 | \description{ 30 | \code{testthat} expectation for a Shiny update 31 | } 32 | \examples{ 33 | \dontrun{ 34 | ## https://github.com/rstudio/shiny-examples/tree/main/050-kmeans-example 35 | app <- ShinyDriver$new("050-kmeans-example") 36 | expectUpdate(app, xcol = "Sepal.Width", output = "plot1") 37 | expectUpdate(app, ycol = "Petal.Width", output = "plot1") 38 | expectUpdate(app, clusters = 4, output = "plot1") 39 | } 40 | } 41 | \keyword{internal} 42 | -------------------------------------------------------------------------------- /man/expect_pass.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/testthat.R 3 | \name{expect_pass} 4 | \alias{expect_pass} 5 | \title{Expectation: \code{testApp()} passes snapshot tests} 6 | \usage{ 7 | expect_pass(object, info = NULL) 8 | } 9 | \arguments{ 10 | \item{object}{The results returned by \code{\link[=testApp]{testApp()}}.} 11 | 12 | \item{info}{Extra information to be included in the message (useful when 13 | writing tests in loops).} 14 | } 15 | \description{ 16 | This returns an testthat expectation object. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | expect_pass(testApp("path/to/app/")) 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /man/installDependencies.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/phantom.R 3 | \name{dependenciesInstalled} 4 | \alias{dependenciesInstalled} 5 | \alias{installDependencies} 6 | \title{Checks for/installs dependencies} 7 | \usage{ 8 | dependenciesInstalled() 9 | 10 | installDependencies() 11 | } 12 | \value{ 13 | \code{TRUE} when all dependencies are fulfilled; otherwise, \code{FALSE}. 14 | } 15 | \description{ 16 | \code{dependenciesInstalled()} that all the required system dependency, 17 | PhantomJS, is installed, and \code{installDependencies()} installs it if needed. 18 | For more information about where PhantomJS will be installed 19 | see \code{\link[webdriver:install_phantomjs]{webdriver::install_phantomjs()}}. 20 | } 21 | -------------------------------------------------------------------------------- /man/migrateShinytestDir.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/migrate-shinytest-dir.R 3 | \name{migrateShinytestDir} 4 | \alias{migrateShinytestDir} 5 | \title{Migrate legacy \pkg{shinytest} files to new test directory structure} 6 | \usage{ 7 | migrateShinytestDir(appdir, dryrun = FALSE) 8 | } 9 | \arguments{ 10 | \item{appdir}{A directory containing a Shiny application.} 11 | 12 | \item{dryrun}{If \code{TRUE}, print out the changes that would be made, but don't 13 | actually do them.} 14 | } 15 | \description{ 16 | This function migrates the old-style directory structure used by 17 | \pkg{shinytest} (versions 1.3.1 and below) to new test directory structure 18 | used in shinytest 1.4.0 and above. 19 | } 20 | \details{ 21 | Before \pkg{shinytest} 1.4.0, the shinytest scripts and results were put in a 22 | subdirectory of the application named \verb{tests/}. As of \pkg{shinytest} 1.4.0, 23 | the tests are put in \verb{tests/shinytest/}, so that it works with the 24 | \code{runTests()} function shiny package (added in \pkg{shiny} 1.5.0). 25 | 26 | With \pkg{shinytest} 1.3.1 and below, the tests/ subdirectory of the 27 | application was used specifically for \pkg{shinytest}, and could not be used 28 | for other types of tests. So the directory structure would look like this: 29 | 30 | \if{html}{\out{
}}\preformatted{appdir/ 31 | `- tests 32 | `- mytest.R 33 | }\if{html}{\out{
}} 34 | 35 | In Shiny 1.5.0, the \code{shiny::runTests()} function was added, and it will run 36 | test scripts tests/ subdirectory of the application. This makes it possible 37 | to use other testing systems in addition to shinytest. \pkg{shinytest} 1.4.0 38 | is designed to work with this new directory structure. The directory 39 | structure looks something like this: 40 | 41 | \if{html}{\out{
}}\preformatted{appdir/ 42 | |- R 43 | |- tests 44 | |- shinytest.R 45 | |- shinytest 46 | | `- mytest.R 47 | |- testthat.R 48 | `- testthat 49 | `- test-script.R 50 | }\if{html}{\out{
}} 51 | 52 | This allows for tests using the \pkg{shinytest} package as well as other 53 | testing tools, such as the \code{shiny::testServer()} function, which can be used 54 | for testing module and server logic, and for unit tests of functions in an R/ 55 | subdirectory. 56 | 57 | In \pkg{shinytest} 1.4.0 and above, it defaults to creating the new directory 58 | structure. 59 | } 60 | -------------------------------------------------------------------------------- /man/osName.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{osName} 4 | \alias{osName} 5 | \title{Get the name of the OS} 6 | \usage{ 7 | osName() 8 | } 9 | \description{ 10 | Returns the name of the current OS. This can be useful for the \code{suffix} when 11 | running \code{\link[=testApp]{testApp()}}. 12 | } 13 | -------------------------------------------------------------------------------- /man/recordTest.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recorder.R 3 | \name{recordTest} 4 | \alias{recordTest} 5 | \title{Launch test event recorder for a Shiny app} 6 | \usage{ 7 | recordTest( 8 | app = ".", 9 | save_dir = NULL, 10 | load_mode = FALSE, 11 | seed = NULL, 12 | loadTimeout = 10000, 13 | debug = "shiny_console", 14 | shinyOptions = list() 15 | ) 16 | } 17 | \arguments{ 18 | \item{app}{A \code{\link[=ShinyDriver]{ShinyDriver()}} object, or path to a Shiny 19 | application.} 20 | 21 | \item{save_dir}{A directory to save stuff.} 22 | 23 | \item{load_mode}{A boolean that determines whether or not the resulting test 24 | script should be appropriate for load testing.} 25 | 26 | \item{seed}{A random seed to set before running the app. This seed will also 27 | be used in the test script.} 28 | 29 | \item{loadTimeout}{Maximum time to wait for the Shiny application to load, in 30 | milliseconds. If a value is provided, it will be saved in the test script.} 31 | 32 | \item{debug}{start the underlying \code{\link[=ShinyDriver]{ShinyDriver()}} in \code{debug} 33 | mode and print those debug logs to the R console once recording is 34 | finished. The default, \code{'shiny_console'}, captures and prints R 35 | console output from the recorded R shiny process. Any value that the 36 | \code{debug} argument in \code{\link[=ShinyDriver]{ShinyDriver()}} accepts may be used 37 | (e.g., \code{'none'} may be used to completely suppress the driver logs).} 38 | 39 | \item{shinyOptions}{A list of options to pass to \code{runApp()}. If a value 40 | is provided, it will be saved in the test script.} 41 | } 42 | \description{ 43 | Launch test event recorder for a Shiny app 44 | } 45 | -------------------------------------------------------------------------------- /man/registerInputProcessor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recorder.R 3 | \name{registerInputProcessor} 4 | \alias{registerInputProcessor} 5 | \alias{getInputProcessors} 6 | \title{Register an input processor for the test recorder} 7 | \usage{ 8 | registerInputProcessor(inputType, processor) 9 | 10 | getInputProcessors() 11 | } 12 | \arguments{ 13 | \item{inputType}{The name of an input type, for example, 14 | \code{"mypkg.numberinput"}.} 15 | 16 | \item{processor}{An input processor function.} 17 | } 18 | \description{ 19 | \code{registerInputProcessor()} registers an input processor which will be used by 20 | the test recorder. The input processor function should take one parameter, 21 | \code{value}, and return a string of R code which returns the desired value. 22 | 23 | \code{getInputProcessors()} returns a named list of all registered input processor 24 | functions. 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/shinytest-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/shinytest-package.R 3 | \docType{package} 4 | \name{shinytest-package} 5 | \alias{shinytest} 6 | \alias{shinytest-package} 7 | \title{shinytest: Test Shiny Apps} 8 | \description{ 9 | Please see the shinytest to shinytest2 migration guide at https://rstudio.github.io/shinytest2/articles/z-migration.html 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://github.com/rstudio/shinytest} 15 | \item Report bugs at \url{https://github.com/rstudio/shinytest/issues} 16 | } 17 | 18 | } 19 | \author{ 20 | \strong{Maintainer}: Winston Chang \email{winston@posit.co} 21 | 22 | Authors: 23 | \itemize{ 24 | \item Gábor Csárdi \email{gabor@posit.co} 25 | \item Hadley Wickham \email{hadley@posit.co} 26 | } 27 | 28 | Other contributors: 29 | \itemize{ 30 | \item Posit Software, PBC [copyright holder, funder] 31 | \item Ascent Digital Services [copyright holder, conceptor] 32 | } 33 | 34 | } 35 | \keyword{internal} 36 | -------------------------------------------------------------------------------- /man/snapshotCompare.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/snapshot.R 3 | \name{snapshotCompare} 4 | \alias{snapshotCompare} 5 | \alias{snapshotUpdate} 6 | \title{Compare current and expected snapshots} 7 | \usage{ 8 | snapshotCompare( 9 | appDir, 10 | testnames = NULL, 11 | autoremove = TRUE, 12 | images = TRUE, 13 | quiet = FALSE, 14 | interactive = is_interactive(), 15 | suffix = NULL 16 | ) 17 | 18 | snapshotUpdate(appDir = ".", testnames = NULL, quiet = FALSE, suffix = NULL) 19 | } 20 | \arguments{ 21 | \item{appDir}{Directory that holds the tests for an application. This is the 22 | parent directory for the expected and current snapshot directories.} 23 | 24 | \item{testnames}{Name or names of a test. If NULL, compare all test results.} 25 | 26 | \item{autoremove}{If the current results match the expected results, should 27 | the current results be removed automatically? Defaults to TRUE.} 28 | 29 | \item{images}{Should screenshots and PNG images be compared? It can be useful 30 | to set this to \code{FALSE} when the expected results were taken on a 31 | different platform from the current results.} 32 | 33 | \item{quiet}{Should output be suppressed? This is useful for automated 34 | testing.} 35 | 36 | \item{interactive}{If there are any differences between current results and 37 | expected results, provide an interactive graphical viewer that shows the 38 | changes and allows the user to accept or reject the changes.} 39 | 40 | \item{suffix}{An optional suffix for the expected results directory. For 41 | example, if the suffix is \code{"mac"}, the expected directory would be 42 | \code{mytest-expected-mac}.} 43 | } 44 | \description{ 45 | This compares current and expected snapshots for a test set, and prints any 46 | differences to the console. 47 | } 48 | \seealso{ 49 | \code{\link[=testApp]{testApp()}} 50 | } 51 | \keyword{internal} 52 | -------------------------------------------------------------------------------- /man/testApp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/test-app.R 3 | \name{testApp} 4 | \alias{testApp} 5 | \title{Run tests for a Shiny application} 6 | \usage{ 7 | testApp( 8 | appDir = ".", 9 | testnames = NULL, 10 | quiet = FALSE, 11 | compareImages = TRUE, 12 | interactive = is_interactive(), 13 | suffix = NULL 14 | ) 15 | } 16 | \arguments{ 17 | \item{appDir}{Path to directory containing a Shiny app (e.g. \code{app.R}) or 18 | single interactive \code{.Rmd}.} 19 | 20 | \item{testnames}{Test script(s) to run. The .R extension of the filename is 21 | optional. For example, \code{"mytest"} or \code{c("mytest", "mytest2.R")}. 22 | If \code{NULL} (the default), all scripts in the tests/ directory will be 23 | run.} 24 | 25 | \item{quiet}{Should output be suppressed? This is useful for automated 26 | testing.} 27 | 28 | \item{compareImages}{Should screenshots be compared? It can be useful to set 29 | this to \code{FALSE} when the expected results were taken on a different 30 | platform from the one currently being used to test the application.} 31 | 32 | \item{interactive}{If there are any differences between current results and 33 | expected results, provide an interactive graphical viewer that shows the 34 | changes and allows the user to accept or reject the changes.} 35 | 36 | \item{suffix}{An optional suffix for the expected results directory. For 37 | example, if the suffix is \code{"mac"}, the expected directory would be 38 | \code{mytest-expected-mac}.} 39 | } 40 | \description{ 41 | Run tests for a Shiny application 42 | } 43 | \seealso{ 44 | \code{\link[=snapshotCompare]{snapshotCompare()}} and \code{\link[=snapshotUpdate]{snapshotUpdate()}} if 45 | you want to compare or update snapshots after testing. In most cases, the 46 | user is prompted to do these tasks interactively, but there are also times 47 | where it is useful to call these functions from the console. 48 | } 49 | -------------------------------------------------------------------------------- /man/textTestDiff.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/view-diff.R 3 | \name{textTestDiff} 4 | \alias{textTestDiff} 5 | \title{Get textual diff of test results} 6 | \usage{ 7 | textTestDiff(appDir = ".", testnames = NULL, images = TRUE, suffix = NULL) 8 | } 9 | \arguments{ 10 | \item{appDir}{Directory of the Shiny application that was tested.} 11 | 12 | \item{testnames}{A character vector of names of tests to compare. If NULL, 13 | compare all test results for which there are differences.} 14 | 15 | \item{images}{Compare screenshot images.} 16 | 17 | \item{suffix}{An optional suffix for the expected results directory. For 18 | example, if the suffix is \code{"mac"}, the expected directory would be 19 | \code{mytest-expected-mac}.} 20 | } 21 | \description{ 22 | Get textual diff of test results 23 | } 24 | \seealso{ 25 | \code{\link[=viewTestDiff]{viewTestDiff()}} for interactive diff viewer. 26 | } 27 | \keyword{internal} 28 | -------------------------------------------------------------------------------- /man/viewTestDiff.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/view-diff.R 3 | \name{viewTestDiff} 4 | \alias{viewTestDiff} 5 | \title{View differences in test results} 6 | \usage{ 7 | viewTestDiff( 8 | appDir = ".", 9 | testnames = NULL, 10 | interactive = is_interactive(), 11 | images = TRUE, 12 | suffix = NULL 13 | ) 14 | } 15 | \arguments{ 16 | \item{appDir}{Directory of the Shiny application that was tested.} 17 | 18 | \item{testnames}{A character vector of names of tests to compare. If NULL, 19 | compare all test results for which there are differences.} 20 | 21 | \item{interactive}{If TRUE, use the interactive diff viewer, which runs in a 22 | Shiny app. If FALSE, print a textual diff, generated by 23 | \code{\link[=textTestDiff]{textTestDiff()}}.} 24 | 25 | \item{images}{Compare screenshot images (only used when \code{interactive} is 26 | FALSE).} 27 | 28 | \item{suffix}{An optional suffix for the expected results directory. For 29 | example, if the suffix is \code{"mac"}, the expected directory would be 30 | \code{mytest-expected-mac}.} 31 | } 32 | \value{ 33 | A character vector the same length as \code{testnames}, with 34 | \code{"accept"} or \code{"reject"} for each test. 35 | } 36 | \description{ 37 | View differences in test results 38 | } 39 | \seealso{ 40 | \code{\link[=textTestDiff]{textTestDiff()}} to get a text diff as a string. 41 | } 42 | \keyword{internal} 43 | -------------------------------------------------------------------------------- /man/viewTestDiffWidget.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/view-diff.R 3 | \name{viewTestDiffWidget} 4 | \alias{viewTestDiffWidget} 5 | \title{Interactive viewer widget for changes in test results} 6 | \usage{ 7 | viewTestDiffWidget(appDir = ".", testname = NULL, suffix = NULL) 8 | } 9 | \arguments{ 10 | \item{appDir}{Directory of the Shiny application that was tested.} 11 | 12 | \item{testname}{Name of test to compare.} 13 | 14 | \item{suffix}{An optional suffix for the expected results directory. For 15 | example, if the suffix is \code{"mac"}, the expected directory would be 16 | \code{mytest-expected-mac}.} 17 | } 18 | \description{ 19 | Interactive viewer widget for changes in test results 20 | } 21 | \keyword{internal} 22 | -------------------------------------------------------------------------------- /pkgdown/extra.css: -------------------------------------------------------------------------------- 1 | .contents img { 2 | margin-bottom: 20px; 3 | 4 | box-shadow: 3px 3px 10px 0px rgba(0,0,0,0.25); 5 | } -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:----------------------------| 5 | |version |R version 4.0.2 (2020-06-22) | 6 | |os |macOS 10.16 | 7 | |system |x86_64, darwin17.0 | 8 | |ui |X11 | 9 | |language |(EN) | 10 | |collate |en_US.UTF-8 | 11 | |ctype |en_US.UTF-8 | 12 | |tz |America/New_York | 13 | |date |2021-08-19 | 14 | 15 | # Dependencies 16 | 17 | |package |old |new |Δ | 18 | |:---------|:-----|:-----|:--| 19 | |shinytest |1.5.0 |1.5.1 |* | 20 | 21 | # Revdeps 22 | 23 | ## All (31) 24 | 25 | |package |version |error |warning |note | 26 | |:----------------------------------------------|:-------|:-----|:-------|:----| 27 | |baRcodeR |0.1.5 | | | | 28 | |[BayesianNetwork](problems.md#bayesiannetwork) |0.1.5 | | |1 | 29 | |[codebook](problems.md#codebook) |0.9.2 | | |2 | 30 | |colocr |0.1.1 | | | | 31 | |[corporaexplorer](problems.md#corporaexplorer) |0.8.4 | | |1 | 32 | |crunchy |0.3.3 | | | | 33 | |disaggR |1.0.1 | | | | 34 | |[dqshiny](problems.md#dqshiny) |0.0.4 |1 | | | 35 | |eAnalytics |0.1.4 | | | | 36 | |evaluator |0.4.3 | | | | 37 | |EventDetectGUI |0.3.0 | | | | 38 | |[GenEst](problems.md#genest) |1.4.6 | | |1 | 39 | |[grapesAgri1](problems.md#grapesagri1) |1.1.0 | | |1 | 40 | |[jsmodule](problems.md#jsmodule) |1.1.8 | | |1 | 41 | |[leafdown](problems.md#leafdown) |1.0.0 | | |2 | 42 | |[mlr3shiny](problems.md#mlr3shiny) |0.1.1 | | |1 | 43 | |[mmaqshiny](problems.md#mmaqshiny) |1.0.0 | | |2 | 44 | |MtreeRing |1.4.5 | | | | 45 | |nomnoml |0.2.3 | | | | 46 | |[oolong](problems.md#oolong) |0.4.0 | | |1 | 47 | |optimall |0.1.0 | | | | 48 | |[plotly](problems.md#plotly) |4.9.4.1 | | |1 | 49 | |presize |0.2.3 | | | | 50 | |r2d3 |0.2.5 | | | | 51 | |[safetyGraphics](problems.md#safetygraphics) |1.1.0 | | |1 | 52 | |[shiny](problems.md#shiny) |1.6.0 | | |1 | 53 | |shinyauthr |1.0.0 | | | | 54 | |shinybrms |1.5.1 | | | | 55 | |[spotGUI](problems.md#spotgui) |0.2.3 | | |1 | 56 | |target |1.4.0 | | | | 57 | |[tidycells](problems.md#tidycells) |0.2.2 |2 | | | 58 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 31 reverse dependencies (30 from CRAN + 1 from BioConductor), comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /shinytest.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(shinytest) 3 | 4 | if (Sys.getenv("NOT_CRAN", "") != "" || Sys.getenv("CI", "") != "") { 5 | if (!dependenciesInstalled()) installDependencies() 6 | message("Using phantom.js from ", shinytest:::find_phantom(), "\n") 7 | test_check("shinytest") 8 | } 9 | -------------------------------------------------------------------------------- /tests/testthat/apps/006-tabsets-id/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Title: Tabsets 2 | Author: RStudio, Inc. 3 | AuthorUrl: http://www.rstudio.com/ 4 | License: MIT 5 | Tags: getting-started 6 | Type: Shiny 7 | -------------------------------------------------------------------------------- /tests/testthat/apps/006-tabsets-id/Readme.md: -------------------------------------------------------------------------------- 1 | This example demonstrates the `tabsetPanel` and `tabPanel` widgets. 2 | 3 | Notice that outputs that are not visible are not re-evaluated until they become visible. Try this: 4 | 5 | 1. Scroll to the bottom of `server.R` 6 | 2. Change the number of observations, and observe that only `output$plot` is evaluated. 7 | 3. Click the Summary tab, and observe that `output$summary` is evaluated. 8 | 4. Change the number of observations again, and observe that now only `output$summary` is evaluated. 9 | 10 | -------------------------------------------------------------------------------- /tests/testthat/apps/006-tabsets-id/server.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | # Define server logic for random distribution application 4 | function(input, output) { 5 | 6 | # Reactive expression to generate the requested distribution. 7 | # This is called whenever the inputs change. The output 8 | # functions defined below then all use the value computed from 9 | # this expression 10 | data <- reactive({ 11 | dist <- switch(input$dist, 12 | norm = rnorm, 13 | unif = runif, 14 | lnorm = rlnorm, 15 | exp = rexp, 16 | rnorm) 17 | 18 | dist(input$n) 19 | }) 20 | 21 | # Generate a plot of the data. Also uses the inputs to build 22 | # the plot label. Note that the dependencies on both the inputs 23 | # and the data reactive expression are both tracked, and 24 | # all expressions are called in the sequence implied by the 25 | # dependency graph 26 | output$plot <- renderPlot({ 27 | dist <- input$dist 28 | n <- input$n 29 | 30 | hist(data(), 31 | main=paste('r', dist, '(', n, ')', sep='')) 32 | }) 33 | 34 | # Generate a summary of the data 35 | output$summary <- renderPrint({ 36 | summary(data()) 37 | }) 38 | 39 | # Generate an HTML table view of the data 40 | output$table <- renderTable({ 41 | data.frame(x=data()) 42 | }) 43 | 44 | } 45 | -------------------------------------------------------------------------------- /tests/testthat/apps/006-tabsets-id/ui.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | # Define UI for random distribution application 4 | fluidPage( 5 | 6 | # Application title 7 | titlePanel("Tabsets"), 8 | 9 | # Sidebar with controls to select the random distribution type 10 | # and number of observations to generate. Note the use of the 11 | # br() element to introduce extra vertical spacing 12 | sidebarLayout( 13 | sidebarPanel( 14 | radioButtons("dist", "Distribution type:", 15 | c("Normal" = "norm", 16 | "Uniform" = "unif", 17 | "Log-normal" = "lnorm", 18 | "Exponential" = "exp")), 19 | br(), 20 | 21 | sliderInput("n", 22 | "Number of observations:", 23 | value = 500, 24 | min = 1, 25 | max = 1000) 26 | ), 27 | 28 | # Show a tabset that includes a plot, summary, and table view 29 | # of the generated distribution 30 | mainPanel( 31 | tabsetPanel(type = "tabs", id = "tabs", 32 | tabPanel("Plot", plotOutput("plot")), 33 | tabPanel("Summary", verbatimTextOutput("summary")), 34 | tabPanel("Table", tableOutput("table")) 35 | ) 36 | ) 37 | ) 38 | ) 39 | -------------------------------------------------------------------------------- /tests/testthat/apps/050-kmeans-example/.gitignore: -------------------------------------------------------------------------------- 1 | Rplots.pdf 2 | -------------------------------------------------------------------------------- /tests/testthat/apps/050-kmeans-example/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Title: Kmeans example 2 | License: MIT 3 | Author: Joe Cheng 4 | AuthorUrl: http://www.rstudio.com/ 5 | Tags: getting-started kmeans plotoutput sliderinput numericinput reactivity 6 | Type: Shiny 7 | -------------------------------------------------------------------------------- /tests/testthat/apps/050-kmeans-example/server.R: -------------------------------------------------------------------------------- 1 | palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3", 2 | "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999")) 3 | 4 | shinyServer(function(input, output, session) { 5 | 6 | # Combine the selected variables into a new data frame 7 | selectedData <- reactive({ 8 | iris[, c(input$xcol, input$ycol)] 9 | }) 10 | 11 | clusters <- reactive({ 12 | kmeans(selectedData(), input$clusters) 13 | }) 14 | 15 | output$plot1 <- renderPlot({ 16 | par(mar = c(5.1, 4.1, 0, 1)) 17 | plot(selectedData(), 18 | col = clusters()$cluster, 19 | pch = 20, cex = 3) 20 | points(clusters()$centers, pch = 4, cex = 4, lwd = 4) 21 | }) 22 | 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/apps/050-kmeans-example/ui.R: -------------------------------------------------------------------------------- 1 | shinyUI(pageWithSidebar( 2 | headerPanel('Iris k-means clustering'), 3 | sidebarPanel( 4 | selectInput('xcol', 'X Variable', names(iris)), 5 | selectInput('ycol', 'Y Variable', names(iris), 6 | selected=names(iris)[[2]]), 7 | numericInput('clusters', 'Cluster count', 3, 8 | min = 1, max = 9) 9 | ), 10 | mainPanel( 11 | plotOutput('plot1') 12 | ) 13 | )) 14 | -------------------------------------------------------------------------------- /tests/testthat/apps/081-widgets-gallery/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Title: Widget Gallery 2 | Author: RStudio, Inc. 3 | AuthorUrl: http://www.rstudio.com/ 4 | License: MIT 5 | Tags: widgets 6 | Type: Shiny 7 | -------------------------------------------------------------------------------- /tests/testthat/apps/081-widgets-gallery/server.R: -------------------------------------------------------------------------------- 1 | function(input, output) { 2 | 3 | output$actionOut <- renderPrint({ input$action }) 4 | output$checkboxOut <- renderPrint({ input$checkbox }) 5 | output$checkGroupOut <- renderPrint({ input$checkGroup }) 6 | output$dateOut <- renderPrint({ input$date }) 7 | output$datesOut <- renderPrint({ input$dates }) 8 | output$fileOut <- renderPrint({ input$file }) 9 | output$numOut <- renderPrint({ input$num }) 10 | output$radioOut <- renderPrint({ input$radio }) 11 | output$selectOut <- renderPrint({ input$select }) 12 | output$slider1Out <- renderPrint({ input$slider1 }) 13 | output$slider2Out <- renderPrint({ input$slider2 }) 14 | #output$submitOut <- renderPrint({ input$submit }) 15 | output$textOut <- renderPrint({ input$text }) 16 | 17 | } 18 | -------------------------------------------------------------------------------- /tests/testthat/apps/081-widgets-gallery/ui.R: -------------------------------------------------------------------------------- 1 | fluidPage( 2 | 3 | tags$head(tags$style(HTML(" 4 | .shiny-text-output { 5 | background-color:#fff; 6 | } 7 | "))), 8 | 9 | h1("Shiny", span("Widgets Gallery", style = "font-weight: 300"), 10 | style = "font-family: 'Source Sans Pro'; 11 | color: #fff; text-align: center; 12 | background-image: url('texturebg.png'); 13 | padding: 20px"), 14 | br(), 15 | 16 | fluidRow( 17 | column(6, offset = 3, 18 | p("For each widget below, the Current Value(s) window 19 | displays the value that the widget provides to shinyServer. 20 | Notice that the values change as you interact with the widgets.", 21 | style = "font-family: 'Source Sans Pro';") 22 | ) 23 | ), 24 | 25 | 26 | br(), 27 | 28 | fluidRow( 29 | 30 | column(4, 31 | wellPanel( 32 | h3("Action button"), 33 | actionButton("action", label = "Action"), 34 | hr(), 35 | p("Current Value:", style = "color:#888888;"), 36 | verbatimTextOutput("actionOut"), 37 | a("See Code", class = "btn btn-primary btn-md", 38 | href = "https://gallery.shinyapps.io/068-widget-action-button/") 39 | )), 40 | 41 | column(4, 42 | wellPanel( 43 | h3("Single checkbox"), 44 | checkboxInput("checkbox", label = "Choice A", 45 | value = TRUE), 46 | hr(), 47 | p("Current Value:", style = "color:#888888;"), 48 | verbatimTextOutput("checkboxOut"), 49 | a("See Code", class = "btn btn-primary btn-md", 50 | href = "https://gallery.shinyapps.io/070-widget-checkbox/") 51 | )), 52 | 53 | column(4, 54 | wellPanel( 55 | checkboxGroupInput("checkGroup", 56 | label = h3("Checkbox group"), 57 | choices = list("Choice 1" = 1, "Choice 2" = 2, 58 | "Choice 3" = 3), 59 | selected = 1), 60 | hr(), 61 | p("Current Values:", style = "color:#888888;"), 62 | verbatimTextOutput("checkGroupOut"), 63 | a("See Code", class = "btn btn-primary btn-md", 64 | href = "https://gallery.shinyapps.io/069-widget-check-group/") 65 | )) 66 | ), 67 | 68 | fluidRow( 69 | 70 | column(4, 71 | wellPanel( 72 | dateInput("date", label = h3("Date input"), value = "2014-01-01"), 73 | hr(), 74 | p("Current Value:", style = "color:#888888;"), 75 | verbatimTextOutput("dateOut"), 76 | a("See Code", class = "btn btn-primary btn-md", 77 | href = "https://gallery.shinyapps.io/071-widget-date/") 78 | )), 79 | 80 | column(4, 81 | wellPanel( 82 | dateRangeInput("dates", label = h3("Date range"), 83 | start = "2014-01-01", end = "2015-01-01"), 84 | hr(), 85 | p("Current Values:", style = "color:#888888;"), 86 | verbatimTextOutput("datesOut"), 87 | a("See Code", class = "btn btn-primary btn-md", 88 | href = "https://gallery.shinyapps.io/072-widget-date-range/") 89 | )), 90 | 91 | column(4, 92 | wellPanel( 93 | fileInput("file", label = h3("File input")), 94 | hr(), 95 | p("Current Value:", style = "color:#888888;"), 96 | verbatimTextOutput("fileOut"), 97 | a("See Code", class = "btn btn-primary btn-md", 98 | href = "https://gallery.shinyapps.io/073-widget-file/") 99 | )) 100 | ), 101 | 102 | fluidRow( 103 | 104 | column(4, 105 | wellPanel( 106 | numericInput("num", label = h3("Numeric input"), value = 1), 107 | hr(), 108 | p("Current Value:", style = "color:#888888;"), 109 | verbatimTextOutput("numOut"), 110 | a("See Code", class = "btn btn-primary btn-md", 111 | href = "https://gallery.shinyapps.io/074-widget-numeric/") 112 | )), 113 | 114 | column(4, 115 | wellPanel( 116 | radioButtons("radio", label = h3("Radio buttons"), 117 | choices = list("Choice 1" = 1, "Choice 2" = 2, "Choice 3" = 3), 118 | selected = 1), 119 | hr(), 120 | p("Current Values:", style = "color:#888888;"), 121 | verbatimTextOutput("radioOut"), 122 | a("See Code", class = "btn btn-primary btn-md", 123 | href = "https://gallery.shinyapps.io/075-widget-radio/") 124 | )), 125 | 126 | column(4, 127 | wellPanel( 128 | selectInput("select", label = h3("Select box"), 129 | choices = list("Choice 1" = 1, "Choice 2" = 2, 130 | "Choice 3" = 3), selected = 1), 131 | hr(), 132 | p("Current Value:", style = "color:#888888;"), 133 | verbatimTextOutput("selectOut"), 134 | a("See Code", class = "btn btn-primary btn-md", 135 | href = "https://gallery.shinyapps.io/076-widget-select/") 136 | )) 137 | ), 138 | 139 | fluidRow( 140 | 141 | column(4, 142 | wellPanel( 143 | sliderInput("slider1", label = h3("Slider"), min = 0, max = 100, 144 | value = 50), 145 | hr(), 146 | p("Current Value:", style = "color:#888888;"), 147 | verbatimTextOutput("slider1Out"), 148 | a("See Code", class = "btn btn-primary btn-md", 149 | href = "https://gallery.shinyapps.io/077-widget-slider/") 150 | )), 151 | 152 | column(4, 153 | wellPanel( 154 | sliderInput("slider2", label = h3("Slider range"), min = 0, 155 | max = 100, value = c(25, 75)), 156 | hr(), 157 | p("Current Values:", style = "color:#888888;"), 158 | verbatimTextOutput("slider2Out"), 159 | a("See Code", class = "btn btn-primary btn-md", 160 | href = "https://gallery.shinyapps.io/077-widget-slider/") 161 | )), 162 | 163 | column(4, 164 | wellPanel( 165 | textInput("text", label = h3("Text input"), 166 | value = "Enter text..."), 167 | hr(), 168 | p("Current Value:", style = "color:#888888;"), 169 | verbatimTextOutput("textOut"), 170 | a("See Code", class = "btn btn-primary btn-md", 171 | href = "https://gallery.shinyapps.io/080-widget-text/") 172 | )) 173 | ) 174 | 175 | ) 176 | -------------------------------------------------------------------------------- /tests/testthat/apps/081-widgets-gallery/widgets.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | -------------------------------------------------------------------------------- /tests/testthat/apps/081-widgets-gallery/www/texturebg.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/tests/testthat/apps/081-widgets-gallery/www/texturebg.png -------------------------------------------------------------------------------- /tests/testthat/apps/click-me/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | ui <- fluidPage( 3 | actionButton("click", "Click me!"), 4 | textOutput("i") 5 | ) 6 | server <- function(input, output, session) { 7 | i <- reactiveVal(0) 8 | 9 | observeEvent(input$click, { 10 | i(i() + 1) 11 | }) 12 | 13 | output$i <- renderText(i()) 14 | } 15 | shinyApp(ui, server) -------------------------------------------------------------------------------- /tests/testthat/apps/embedded-tabs/server.R: -------------------------------------------------------------------------------- 1 | shinyServer(function(input, output, session) { }) 2 | -------------------------------------------------------------------------------- /tests/testthat/apps/embedded-tabs/ui.R: -------------------------------------------------------------------------------- 1 | 2 | shinyUI(pageWithSidebar( 3 | headerPanel(""), 4 | sidebarPanel(), 5 | mainPanel( 6 | tabsetPanel( 7 | id = "tabset1", 8 | tabPanel( 9 | "tab1", 10 | tabsetPanel( 11 | id = "tabset11", 12 | tabPanel("tab11"), 13 | tabPanel("tab12"), 14 | tabPanel("tab13") 15 | ) 16 | ), 17 | tabPanel( 18 | "tab2", 19 | tabsetPanel( 20 | id = "tabset12", 21 | tabPanel("tab21", value = "xxx"), 22 | tabPanel("tab22"), 23 | tabPanel("tab23"), 24 | tabPanel("tab24") 25 | ) 26 | ) 27 | ) 28 | ) 29 | )) 30 | -------------------------------------------------------------------------------- /tests/testthat/apps/id-conflicts-1/app.R: -------------------------------------------------------------------------------- 1 | 2 | shinyApp( 3 | 4 | ui = shinyUI(pageWithSidebar( 5 | headerPanel("Testing Conflicting Widget IDs"), 6 | sidebarPanel( 7 | selectInput("select", "Just a selector", c("p", "h2")), 8 | selectInput("select", "Another selector", c("h2", "p", "a")) 9 | ), 10 | mainPanel( 11 | wellPanel(htmlOutput("html")) 12 | ) 13 | )), 14 | 15 | server = function(input, output, session) { 16 | 17 | output$html <- renderText( 18 | if (input$select == "p") { 19 | HTML("

This is a paragraph.

") 20 | } else { 21 | HTML("

This is a heading

") 22 | } 23 | ) 24 | } 25 | ) 26 | -------------------------------------------------------------------------------- /tests/testthat/apps/id-conflicts-2/app.R: -------------------------------------------------------------------------------- 1 | 2 | shinyApp( 3 | 4 | ui = shinyUI(pageWithSidebar( 5 | headerPanel("Testing Conflicting Widget IDs"), 6 | sidebarPanel( 7 | selectInput("select", "Just a selector", c("p", "h2")) 8 | ), 9 | mainPanel( 10 | wellPanel(htmlOutput("html")), 11 | wellPanel(textOutput("html")) 12 | ) 13 | )), 14 | 15 | server = function(input, output, session) { 16 | 17 | output$html <- renderText( 18 | if (input$select == "p") { 19 | HTML("

This is a paragraph.

") 20 | } else { 21 | HTML("

This is a heading

") 22 | } 23 | ) 24 | } 25 | ) 26 | -------------------------------------------------------------------------------- /tests/testthat/apps/id-conflicts-3/app.R: -------------------------------------------------------------------------------- 1 | 2 | shinyApp( 3 | 4 | ui = shinyUI(pageWithSidebar( 5 | headerPanel("Testing Conflicting Widget IDs"), 6 | sidebarPanel( 7 | selectInput("widget", "Just a selector", c("p", "h2")) 8 | ), 9 | mainPanel( 10 | wellPanel(htmlOutput("widget")) 11 | ) 12 | )), 13 | 14 | server = function(input, output, session) { 15 | 16 | output$widget <- renderText( 17 | if (input$widget == "p") { 18 | HTML("

This is a paragraph.

") 19 | } else { 20 | HTML("

This is a heading

") 21 | } 22 | ) 23 | } 24 | ) 25 | -------------------------------------------------------------------------------- /tests/testthat/apps/outputs/app.R: -------------------------------------------------------------------------------- 1 | 2 | shinyApp( 3 | 4 | ui = shinyUI(pageWithSidebar( 5 | headerPanel("Testing Shiny output widgets"), 6 | sidebarPanel( 7 | selectInput("select", "Just a dummy selector", c("p", "h2")) 8 | ), 9 | mainPanel( 10 | wellPanel(htmlOutput("html")), 11 | wellPanel(verbatimTextOutput("verbatim")), 12 | wellPanel(textOutput("text")) 13 | ) 14 | )), 15 | 16 | server = function(input, output, session) { 17 | 18 | output$html <- renderText( 19 | if (input$select == "p") { 20 | HTML("

This is a paragraph.

") 21 | } else { 22 | HTML("

This is a heading

") 23 | } 24 | ) 25 | 26 | output$verbatim <- renderText( 27 | if (input$select == "p") { 28 | "This is verbatim, really.
" 29 | } else { 30 | "This is verbatim, too" 31 | } 32 | ) 33 | 34 | output$text <- renderText( 35 | if (input$select == "p") { 36 | "This is text.
" 37 | } else { 38 | "This, too" 39 | } 40 | ) 41 | } 42 | ) 43 | -------------------------------------------------------------------------------- /tests/testthat/apps/render-args/.gitignore: -------------------------------------------------------------------------------- 1 | doc.html 2 | -------------------------------------------------------------------------------- /tests/testthat/apps/render-args/doc.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Parameterised report" 3 | runtime: shiny 4 | params: 5 | name: John 6 | --- 7 | 8 | ```{r} 9 | textInput("test", "Your name", value = params$name) 10 | ``` 11 | -------------------------------------------------------------------------------- /tests/testthat/apps/stopApp/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | ui <- fluidPage( 3 | actionButton("quit", "quit") 4 | ) 5 | server <- function(input, output, session) { 6 | observeEvent(input$quit, stopApp()) 7 | } 8 | shinyApp(ui, server) 9 | -------------------------------------------------------------------------------- /tests/testthat/apps/test-exports/app.R: -------------------------------------------------------------------------------- 1 | shinyApp( 2 | ui = basicPage( 3 | h4("Snapshot URL: "), 4 | uiOutput("url"), 5 | h4("Current values:"), 6 | verbatimTextOutput("values"), 7 | actionButton("inc", "Increment x") 8 | ), 9 | 10 | server = function(input, output, session) { 11 | vals <- reactiveValues(x = 1) 12 | y <- reactive({ vals$x + 1 }) 13 | 14 | observeEvent(input$inc, { 15 | vals$x <<- vals$x + 1 16 | }) 17 | 18 | exportTestValues( 19 | x = vals$x, 20 | y = y() 21 | ) 22 | 23 | output$url <- renderUI({ 24 | url <- session$getTestSnapshotUrl(format="json") 25 | a(href = url, url) 26 | }) 27 | 28 | output$values <- renderText({ 29 | paste0("vals$x: ", vals$x, "\ny: ", y()) 30 | }) 31 | } 32 | ) 33 | -------------------------------------------------------------------------------- /tests/testthat/apps/two-rmd/doc1.Rmd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/tests/testthat/apps/two-rmd/doc1.Rmd -------------------------------------------------------------------------------- /tests/testthat/apps/two-rmd/doc2.Rmd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/tests/testthat/apps/two-rmd/doc2.Rmd -------------------------------------------------------------------------------- /tests/testthat/apps/user-error/app.R: -------------------------------------------------------------------------------- 1 | stop("boom") 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/empty-nested/tests/shinytest/file.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rstudio/shinytest/151ead1d5e70ebc3f9c3b10db2baa0550be37db5/tests/testthat/example_test_dirs/empty-nested/tests/shinytest/file.txt -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/empty-nested/tests/st.R: -------------------------------------------------------------------------------- 1 | app <- ShinyDriver$new() 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/empty-toplevel/tests/file.R: -------------------------------------------------------------------------------- 1 | # I am not a shiny test. -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/mixed-toplevel/tests/testa.r: -------------------------------------------------------------------------------- 1 | I'm not a shiny test 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/mixed-toplevel/tests/testb.R: -------------------------------------------------------------------------------- 1 | app<- ShinyDriver$new() 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/nested/tests/shinytest/st.R: -------------------------------------------------------------------------------- 1 | app <- ShinyDriver$new() 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/nested/tests/shinytest/whatever.R: -------------------------------------------------------------------------------- 1 | It doesn't matter what I say 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/simple/tests/testa.r: -------------------------------------------------------------------------------- 1 | app<- ShinyDriver$new() 2 | -------------------------------------------------------------------------------- /tests/testthat/example_test_dirs/simple/tests/testb.R: -------------------------------------------------------------------------------- 1 | app<- ShinyDriver$new() 2 | -------------------------------------------------------------------------------- /tests/testthat/helper-sleep-on-ci.R: -------------------------------------------------------------------------------- 1 | # Wait a little bit before init'ing a new ShinyDriver instance 2 | # Help deter random phantomjs shutdowns on GHA 3 | sleep_on_ci <- function() { 4 | on_ci <- isTRUE(as.logical(Sys.getenv("CI"))) 5 | if (on_ci) { 6 | Sys.sleep(1) 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/.gitignore: -------------------------------------------------------------------------------- 1 | *.png 2 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/009-upload/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | # Define UI for data upload app ---- 4 | ui <- fluidPage( 5 | 6 | # App title ---- 7 | titlePanel("Uploading Files"), 8 | 9 | # Sidebar layout with input and output definitions ---- 10 | sidebarLayout( 11 | 12 | # Sidebar panel for inputs ---- 13 | sidebarPanel( 14 | 15 | # Input: Select a file ---- 16 | fileInput("file1", "Choose CSV File", 17 | multiple = TRUE, 18 | accept = c("text/csv", 19 | "text/comma-separated-values,text/plain", 20 | ".csv")), 21 | 22 | # Horizontal line ---- 23 | tags$hr(), 24 | 25 | # Input: Checkbox if file has header ---- 26 | checkboxInput("header", "Header", TRUE), 27 | 28 | # Input: Select separator ---- 29 | radioButtons("sep", "Separator", 30 | choices = c(Comma = ",", 31 | Semicolon = ";", 32 | Tab = "\t"), 33 | selected = ","), 34 | 35 | # Input: Select quotes ---- 36 | radioButtons("quote", "Quote", 37 | choices = c(None = "", 38 | "Double Quote" = '"', 39 | "Single Quote" = "'"), 40 | selected = '"'), 41 | 42 | # Horizontal line ---- 43 | tags$hr(), 44 | 45 | # Input: Select number of rows to display ---- 46 | radioButtons("disp", "Display", 47 | choices = c(Head = "head", 48 | All = "all"), 49 | selected = "head") 50 | 51 | ), 52 | 53 | # Main panel for displaying outputs ---- 54 | mainPanel( 55 | 56 | # Output: Data file ---- 57 | tableOutput("contents") 58 | 59 | ) 60 | 61 | ) 62 | ) 63 | 64 | # Define server logic to read selected file ---- 65 | server <- function(input, output) { 66 | 67 | output$contents <- renderTable({ 68 | 69 | # input$file1 will be NULL initially. After the user selects 70 | # and uploads a file, head of that data file by default, 71 | # or all rows if selected, will be shown. 72 | 73 | req(input$file1) 74 | 75 | df <- read.csv(input$file1$datapath, 76 | header = input$header, 77 | sep = input$sep, 78 | quote = input$quote) 79 | 80 | if(input$disp == "head") { 81 | return(head(df)) 82 | } 83 | else { 84 | return(df) 85 | } 86 | 87 | }) 88 | 89 | } 90 | 91 | # Create Shiny app ---- 92 | shinyApp(ui, server) 93 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/009-upload/tests/shinytest/mtcars.csv: -------------------------------------------------------------------------------- 1 | "mpg","cyl","disp","hp","drat","wt","qsec","vs","am","gear","carb" 2 | 21,6,160,110,3.9,2.62,16.46,0,1,4,4 3 | 21,6,160,110,3.9,2.875,17.02,0,1,4,4 4 | 22.8,4,108,93,3.85,2.32,18.61,1,1,4,1 5 | 21.4,6,258,110,3.08,3.215,19.44,1,0,3,1 6 | 18.7,8,360,175,3.15,3.44,17.02,0,0,3,2 7 | 18.1,6,225,105,2.76,3.46,20.22,1,0,3,1 8 | 14.3,8,360,245,3.21,3.57,15.84,0,0,3,4 9 | 24.4,4,146.7,62,3.69,3.19,20,1,0,4,2 10 | 22.8,4,140.8,95,3.92,3.15,22.9,1,0,4,2 11 | 19.2,6,167.6,123,3.92,3.44,18.3,1,0,4,4 12 | 17.8,6,167.6,123,3.92,3.44,18.9,1,0,4,4 13 | 16.4,8,275.8,180,3.07,4.07,17.4,0,0,3,3 14 | 17.3,8,275.8,180,3.07,3.73,17.6,0,0,3,3 15 | 15.2,8,275.8,180,3.07,3.78,18,0,0,3,3 16 | 10.4,8,472,205,2.93,5.25,17.98,0,0,3,4 17 | 10.4,8,460,215,3,5.424,17.82,0,0,3,4 18 | 14.7,8,440,230,3.23,5.345,17.42,0,0,3,4 19 | 32.4,4,78.7,66,4.08,2.2,19.47,1,1,4,1 20 | 30.4,4,75.7,52,4.93,1.615,18.52,1,1,4,2 21 | 33.9,4,71.1,65,4.22,1.835,19.9,1,1,4,1 22 | 21.5,4,120.1,97,3.7,2.465,20.01,1,0,3,1 23 | 15.5,8,318,150,2.76,3.52,16.87,0,0,3,2 24 | 15.2,8,304,150,3.15,3.435,17.3,0,0,3,2 25 | 13.3,8,350,245,3.73,3.84,15.41,0,0,3,4 26 | 19.2,8,400,175,3.08,3.845,17.05,0,0,3,2 27 | 27.3,4,79,66,4.08,1.935,18.9,1,1,4,1 28 | 26,4,120.3,91,4.43,2.14,16.7,0,1,5,2 29 | 30.4,4,95.1,113,3.77,1.513,16.9,1,1,5,2 30 | 15.8,8,351,264,4.22,3.17,14.5,0,1,5,4 31 | 19.7,6,145,175,3.62,2.77,15.5,0,1,5,6 32 | 15,8,301,335,3.54,3.57,14.6,0,1,5,8 33 | 21.4,4,121,109,4.11,2.78,18.6,1,1,4,2 34 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/009-upload/tests/shinytest/mytest-expected/001.json: -------------------------------------------------------------------------------- 1 | { 2 | "input": { 3 | "disp": "head", 4 | "file1": { 5 | "name": [ 6 | "mtcars.csv" 7 | ], 8 | "size": [ 9 | 1303 10 | ], 11 | "type": [ 12 | "text/csv" 13 | ], 14 | "datapath": [ 15 | "0.csv" 16 | ] 17 | }, 18 | "header": true, 19 | "quote": "\"", 20 | "sep": "," 21 | }, 22 | "output": { 23 | "contents": "\n\n
mpg <\/th> cyl <\/th> disp <\/th> hp <\/th> drat <\/th> wt <\/th> qsec <\/th> vs <\/th> am <\/th> gear <\/th> carb <\/th> <\/tr> <\/thead>
21.00 <\/td> 6 <\/td> 160.00 <\/td> 110 <\/td> 3.90 <\/td> 2.62 <\/td> 16.46 <\/td> 0 <\/td> 1 <\/td> 4 <\/td> 4 <\/td> <\/tr>\n
21.00 <\/td> 6 <\/td> 160.00 <\/td> 110 <\/td> 3.90 <\/td> 2.88 <\/td> 17.02 <\/td> 0 <\/td> 1 <\/td> 4 <\/td> 4 <\/td> <\/tr>\n
22.80 <\/td> 4 <\/td> 108.00 <\/td> 93 <\/td> 3.85 <\/td> 2.32 <\/td> 18.61 <\/td> 1 <\/td> 1 <\/td> 4 <\/td> 1 <\/td> <\/tr>\n
21.40 <\/td> 6 <\/td> 258.00 <\/td> 110 <\/td> 3.08 <\/td> 3.21 <\/td> 19.44 <\/td> 1 <\/td> 0 <\/td> 3 <\/td> 1 <\/td> <\/tr>\n
18.70 <\/td> 8 <\/td> 360.00 <\/td> 175 <\/td> 3.15 <\/td> 3.44 <\/td> 17.02 <\/td> 0 <\/td> 0 <\/td> 3 <\/td> 2 <\/td> <\/tr>\n
18.10 <\/td> 6 <\/td> 225.00 <\/td> 105 <\/td> 2.76 <\/td> 3.46 <\/td> 20.22 <\/td> 1 <\/td> 0 <\/td> 3 <\/td> 1 <\/td> <\/tr>\n <\/tbody> <\/table>" 24 | }, 25 | "export": { 26 | 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/009-upload/tests/shinytest/mytest-expected/002.json: -------------------------------------------------------------------------------- 1 | { 2 | "input": { 3 | "disp": "head", 4 | "file1": { 5 | "name": [ 6 | "mtcars.csv" 7 | ], 8 | "size": [ 9 | 1303 10 | ], 11 | "type": [ 12 | "text/csv" 13 | ], 14 | "datapath": [ 15 | "0.csv" 16 | ] 17 | }, 18 | "header": false, 19 | "quote": "", 20 | "sep": "," 21 | }, 22 | "output": { 23 | "contents": "\n\n
V1 <\/th> V2 <\/th> V3 <\/th> V4 <\/th> V5 <\/th> V6 <\/th> V7 <\/th> V8 <\/th> V9 <\/th> V10 <\/th> V11 <\/th> <\/tr> <\/thead>
\"mpg\" <\/td> \"cyl\" <\/td> \"disp\" <\/td> \"hp\" <\/td> \"drat\" <\/td> \"wt\" <\/td> \"qsec\" <\/td> \"vs\" <\/td> \"am\" <\/td> \"gear\" <\/td> \"carb\" <\/td> <\/tr>\n
21 <\/td> 6 <\/td> 160 <\/td> 110 <\/td> 3.9 <\/td> 2.62 <\/td> 16.46 <\/td> 0 <\/td> 1 <\/td> 4 <\/td> 4 <\/td> <\/tr>\n
21 <\/td> 6 <\/td> 160 <\/td> 110 <\/td> 3.9 <\/td> 2.875 <\/td> 17.02 <\/td> 0 <\/td> 1 <\/td> 4 <\/td> 4 <\/td> <\/tr>\n
22.8 <\/td> 4 <\/td> 108 <\/td> 93 <\/td> 3.85 <\/td> 2.32 <\/td> 18.61 <\/td> 1 <\/td> 1 <\/td> 4 <\/td> 1 <\/td> <\/tr>\n
21.4 <\/td> 6 <\/td> 258 <\/td> 110 <\/td> 3.08 <\/td> 3.215 <\/td> 19.44 <\/td> 1 <\/td> 0 <\/td> 3 <\/td> 1 <\/td> <\/tr>\n
18.7 <\/td> 8 <\/td> 360 <\/td> 175 <\/td> 3.15 <\/td> 3.44 <\/td> 17.02 <\/td> 0 <\/td> 0 <\/td> 3 <\/td> 2 <\/td> <\/tr>\n <\/tbody> <\/table>" 24 | }, 25 | "export": { 26 | 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/009-upload/tests/shinytest/mytest.R: -------------------------------------------------------------------------------- 1 | app <- ShinyDriver$new("../../") 2 | app$snapshotInit("mytest") 3 | 4 | app$uploadFile(file1 = "mtcars.csv") 5 | app$snapshot() 6 | app$setInputs(header = FALSE) 7 | app$setInputs(quote = "") 8 | app$snapshot() 9 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/041-dynamic-ui/server.R: -------------------------------------------------------------------------------- 1 | function(input, output) { 2 | 3 | output$ui <- renderUI({ 4 | if (is.null(input$input_type)) 5 | return() 6 | 7 | # Depending on input$input_type, we'll generate a different 8 | # UI component and send it to the client. 9 | switch(input$input_type, 10 | "slider" = sliderInput("dynamic", "Dynamic", 11 | min = 1, max = 20, value = 10), 12 | "text" = textInput("dynamic", "Dynamic", 13 | value = "starting value"), 14 | "numeric" = numericInput("dynamic", "Dynamic", 15 | value = 12), 16 | "checkbox" = checkboxInput("dynamic", "Dynamic", 17 | value = TRUE), 18 | "checkboxGroup" = checkboxGroupInput("dynamic", "Dynamic", 19 | choices = c("Option 1" = "option1", 20 | "Option 2" = "option2"), 21 | selected = "option2" 22 | ), 23 | "radioButtons" = radioButtons("dynamic", "Dynamic", 24 | choices = c("Option 1" = "option1", 25 | "Option 2" = "option2"), 26 | selected = "option2" 27 | ), 28 | "selectInput" = selectInput("dynamic", "Dynamic", 29 | choices = c("Option 1" = "option1", 30 | "Option 2" = "option2"), 31 | selected = "option2" 32 | ), 33 | "selectInput (multi)" = selectInput("dynamic", "Dynamic", 34 | choices = c("Option 1" = "option1", 35 | "Option 2" = "option2"), 36 | selected = c("option1", "option2"), 37 | multiple = TRUE 38 | ), 39 | "date" = dateInput("dynamic", "Dynamic"), 40 | "daterange" = dateRangeInput("dynamic", "Dynamic") 41 | ) 42 | }) 43 | 44 | output$input_type_text <- renderText({ 45 | # if (identical(isolate(input$input_type), "checkbox")) { 46 | # Sys.sleep(2.5) 47 | # } 48 | input$input_type 49 | }) 50 | 51 | output$dynamic_value <- renderPrint({ 52 | if (identical(isolate(input$input_type), "checkbox")) { 53 | Sys.sleep(2.5) 54 | } 55 | str(input$dynamic) 56 | }) 57 | 58 | } 59 | -------------------------------------------------------------------------------- /tests/testthat/recorded_tests/041-dynamic-ui/tests/shinytest/mytest-expected/001.json: -------------------------------------------------------------------------------- 1 | { 2 | "input": { 3 | "dynamic": 10, 4 | "input_type": "slider" 5 | }, 6 | "output": { 7 | "dynamic_value": " int 10", 8 | "input_type_text": "slider", 9 | "ui": { 10 | "html": "
\n