add app$waitForValue

DESCRIPTION

@@ -1,9 +1,11 @@
 Package: shinytest
 Title: Test Shiny Apps
-Version: 1.3.1.9001
+Version: 1.3.1.9002
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "[email protected]"),
-    person("Gábor", "Csárdi", role = "aut", email = "[email protected]")
+    person("Gábor", "Csárdi", role = "aut", email = "[email protected]"),
+    person("RStudio", role = c("cph", "fnd")),
+    person("Mango Solutions", role = c("cph", "ccp"))
     )
 Description: For automated testing of Shiny applications, using a headless
     browser, driven through 'WebDriver'.

NEWS.md

@@ -1,13 +1,15 @@
-1.3.1.9001
+shinytest (development version)
 ==========
 
 * Recommend that tests be placed in `tests/shinytests/` 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.
 
-* 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])
+* 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))
 
-* 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])
+* 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))
 
-1.3.1
+* 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))
+
+shinytest 1.3.1
 =======
 
 ## New features
@@ -26,7 +28,7 @@
 
 * `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)
 
-1.3.0
+shinytest 1.3.0
 =====
 
 * First public release

R/app-get-all-values.R

@@ -1,3 +1,4 @@
+# Note: This queries the server
 sd_getAllValues <- function(self, private, input, output, export) {
   "!DEBUG sd_getAllValues"
   url <- private$getTestSnapshotUrl(input, output, export, format = "rds")

R/shiny-driver.R

@@ -31,6 +31,8 @@
 #'
 #' app$waitFor(expr, checkInterval = 100, timeout = 3000)
 #'
+#' app$waitForValue(name, ignore = list(NULL, ""), iotype = "input", timeout = 10000, checkInterval = 400)
+#'
 #' app$listWidgets()
 #'
 #' app$checkUniqueWidgetNames()
@@ -84,6 +86,9 @@
 #'     evaluates to the condition to wait for.}
 #'   \item{checkInterval}{How often to check for the condition, in
 #'     milliseconds.}
+#'   \item{ignore}{List of possible values that are to not be
+#'     considered valid.  \code{app$waitForValue} will continue to poll until
+#'     it finds a value not contained in \code{ignore}.}
 #'   \item{timeout}{Timeout for the condition, in milliseconds.}
 #'   \item{output}{Character vector, the name(s) of the Shiny output
 #'     widgets that should be updated.}
@@ -169,6 +174,13 @@
 #' to \code{true}, or a timeout happens. It returns \code{TRUE} is the
 #' expression evaluated to \code{true}, possible after some waiting.
 #'
+#' \code{app$waitForValue()} waits until the current application's
+#' \code{input} (or \code{output}) value is not one of the supplied invalid
+#' values.  The function returns the value found if the time limit has not
+#' been reached (default is 10 seconds).  This function can be useful in
+#' helping determine if an application has initialized or finished
+#' processing a complex reactive situation.
+#'
 #' \code{app$listWidgets()} lists the names of all input and output
 #' widgets. It returns a list of two character vectors, named \code{input}
 #' and \code{output}.
@@ -220,12 +232,14 @@ ShinyDriver <- R6Class(
     stop = function()
       sd_stop(self, private),
 
+    # Note: This queries the **browser**
     getValue = function(name, iotype = c("auto", "input", "output"))
       sd_getValue(self, private, name, match.arg(iotype)),
 
     setValue = function(name, value, iotype = c("auto", "input", "output"))
       sd_setValue(self, private, name, value, match.arg(iotype)),
 
+    # Note: This queries the server
     getAllValues = function(input = TRUE, output = TRUE, export = TRUE)
       sd_getAllValues(self, private, input, output, export),
 
@@ -287,6 +301,9 @@ ShinyDriver <- R6Class(
     waitFor = function(expr, checkInterval = 100, timeout = 3000)
       sd_waitFor(self, private, expr, checkInterval, timeout),
 
+    waitForValue = function(name, ignore = list(NULL, ""), iotype = c("input", "output", "export"), timeout = 10000, checkInterval = 400) {
+      sd_waitForValue(self, private, name = name, ignore = ignore, iotype = match.arg(iotype), timeout = timeout, checkInterval = checkInterval)
+    },
 
     listWidgets = function()
       sd_listWidgets(self, private),
@@ -408,6 +425,7 @@ ShinyDriver$debugLogTypes <- c(
   "shinytest"
 )
 
+# Note: This queries the **browser**
 sd_getValue <- function(self, private, name, iotype) {
   "!DEBUG sd_getValue `name` (`iotype`)"
   self$findWidget(name, iotype)$getValue()
@@ -470,6 +488,52 @@ sd_waitFor <- function(self, private, expr, checkInterval, timeout) {
   private$web$waitFor(expr, checkInterval, timeout)
 }
 
+sd_waitForValue <- function(self, private, name, ignore = list(NULL, ""), iotype = "input", timeout = 10000, checkInterval = 400) {
+  "!DEBUG sd_waitForValue"
+
+  timeoutSec <- as.numeric(timeout) / 1000
+  if (!is.numeric(timeoutSec) || is.na(timeoutSec) || is.nan(timeoutSec)) {
+    stop("timeout must be numeric")
+  }
+  checkInterval <- as.numeric(checkInterval)
+  if (!is.numeric(checkInterval) || is.na(checkInterval) || is.nan(checkInterval)) {
+    stop("checkInterval must be numeric")
+  }
+
+  now <- function() {
+    as.numeric(Sys.time())
+  }
+
+  endTime <- now() + timeoutSec
+
+  while (TRUE) {
+    value <- try({
+      args <- list()
+      args[[iotype]] <- name
+      do.call(self$getAllValues, args)[[iotype]][[name]]
+    }, silent = TRUE)
+
+    # if no error when trying ot retrieve the value..
+    if (!inherits(value, "try-error")) {
+      # check against all invalid values
+      isInvalid <- vapply(ignore, identical, logical(1), x = value)
+      # if no matches, then it's a success!
+      if (!any(isInvalid)) {
+        return(value)
+      }
+    }
+
+    # if too much time has elapsed... throw
+    if (now() > endTime) {
+      stop("timeout reached when waiting for value: ", name)
+    }
+
+    # wait a little bit for shiny to do some work
+    Sys.sleep(checkInterval / 1000)
+  }
+
+}
+
 sd_listWidgets <- function(self, private) {
   "!DEBUG sd_listWidgets"
   res <- private$web$executeScript("return shinytest.listWidgets();")

R/widget-get-value.R

@@ -36,6 +36,7 @@ widget_getValueFuncs <- list(
   textOutput = function(self, private) {
     private$element$getText()
   }
+
 )
 
 widget_getValuePostprocess <- list(

README.Rmd

@@ -1,3 +1,11 @@
+---
+title: README
+output:
+  md_document:
+    variant: gfm
+    pandoc_args: "--wrap=preserve"
+# compile using `rmarkdown::render("README.Rmd")`
+---
 
 ```{r, setup, echo = FALSE, message = FALSE}
 knitr::opts_chunk$set(
@@ -12,10 +20,15 @@ knitr::opts_chunk$set(
 
 > Test Shiny Apps
 
+<!-- badges: start -->
 [![Linux Build Status](https://travis-ci.org/rstudio/shinytest.svg?branch=master)](https://travis-ci.org/rstudio/shinytest)
 [![Windows Build status](https://ci.appveyor.com/api/projects/status/github/rstudio/shinytest?svg=true)](https://ci.appveyor.com/project/rstudio/shinytest)
 [![](http://www.r-pkg.org/badges/version/shinytest)](http://www.r-pkg.org/pkg/shinytest)
 [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/shinytest)](http://www.r-pkg.org/pkg/shinytest)
+<!-- badges: end -->
+
+[![RStudio community](https://img.shields.io/badge/community-shinytest-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/tags/c/shiny/8/shinytest)
+
 
 ## Installation
 

README.md

@@ -1,29 +1,28 @@
-
-
-
 # shinytest
 
 > Test Shiny Apps
 
+<!-- badges: start -->
+
 [![Linux Build Status](https://travis-ci.org/rstudio/shinytest.svg?branch=master)](https://travis-ci.org/rstudio/shinytest)
 [![Windows Build status](https://ci.appveyor.com/api/projects/status/github/rstudio/shinytest?svg=true)](https://ci.appveyor.com/project/rstudio/shinytest)
 [![](http://www.r-pkg.org/badges/version/shinytest)](http://www.r-pkg.org/pkg/shinytest)
 [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/shinytest)](http://www.r-pkg.org/pkg/shinytest)
+<!-- badges: end -->
+
+[![RStudio community](https://img.shields.io/badge/community-shinytest-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/tags/c/shiny/8/shinytest)
 
 ## Installation
 
 To install the current release version:
 
-
-```r
+``` r
 install.packages("shinytest")
 ```
 
-
 To install the development version:
 
-
-```r
+``` r
 devtools::install_github("rstudio/shinytest")
 ```