From a809bdb44759aaa289a49020c69ee80cdc3c792f Mon Sep 17 00:00:00 2001
From: trestletech <jeff.allen@trestletechnology.net>
Date: Tue, 15 Oct 2019 16:45:25 -0500
Subject: [PATCH] Enable bulk-running of events via large elapse() values.

---
 R/test-module.R                   | 19 ++++++++++++--
 inst/_pkgdown.yml                 |  5 ++++
 tests/testthat/test-test-module.R | 12 ++++-----
 vignettes/integration-testing.Rmd | 43 +++++++++++++++++++++++++++++++
 4 files changed, 70 insertions(+), 9 deletions(-)

diff --git a/R/test-module.R b/R/test-module.R
index 43918a642..5b6fe65a2 100644
--- a/R/test-module.R
+++ b/R/test-module.R
@@ -216,11 +216,26 @@ testModule <- function(module, expr, args, ...) {
   }
 
   session$elapse <- function(millis){
-    timer$elapse(millis)
+    msLeft <- millis
+
+    while (msLeft > 0){
+      t <- timer$timeToNextEvent()
+
+      if (is.infinite(t) || t <= 0 || msLeft < t){
+        # Either there's no good upcoming event or we can't make it to it in the allotted time.
+        break
+      }
+      msLeft <- msLeft - t
+      timer$elapse(t)
+      timer$executeElapsed()
+      session$flush()
+    }
+
+    timer$elapse(msLeft)
 
     # timerCallbacks must run before flushReact.
+    # TODO: needed? We're guaranteed to not have anything to run given the above loop, right?
     timer$executeElapsed()
-
     session$flush()
   }
   # Contract is to return Sys.time, which is seconds, not millis.
diff --git a/inst/_pkgdown.yml b/inst/_pkgdown.yml
index 1c7bb7ff3..0911ffb63 100644
--- a/inst/_pkgdown.yml
+++ b/inst/_pkgdown.yml
@@ -215,3 +215,8 @@ reference:
     contents:
       - shinyApp
       - maskReactiveContext
+  - title: Testing
+    desc: Functions intended for testing of Shiny components
+    contents:
+      - testModule
+      - testServer
diff --git a/tests/testthat/test-test-module.R b/tests/testthat/test-test-module.R
index 6c5368ed3..fd61012fc 100644
--- a/tests/testthat/test-test-module.R
+++ b/tests/testthat/test-test-module.R
@@ -129,7 +129,7 @@ test_that("testModule handles reactivePoll", {
     expect_equal(rv$x, 1)
 
     for (i in 1:4){
-      session$elapse(51)
+      session$elapse(50)
     }
 
     expect_equal(rv$x, 5)
@@ -150,9 +150,7 @@ test_that("testModule handles reactiveTimer", {
   testModule(module, {
     expect_equal(rv$x, 1)
 
-    for (i in 1:4){
-      session$elapse(51)
-    }
+    session$elapse(200)
 
     expect_equal(rv$x, 5)
   })
@@ -186,12 +184,12 @@ test_that("testModule handles debounce/throttle", {
       session$elapse(51)
       session$setInputs(y = TRUE)
       expect_equal(rv$t, i-1)
-      session$elapse(51)
+      session$elapse(51) # TODO: we usually don't have to pad by a ms, but here we do. Investigate.
       expect_equal(rv$t, i)
     }
     # Never sufficient time to debounce. Not incremented
     expect_equal(rv$d, 1)
-    session$elapse(51)
+    session$elapse(50)
 
     # Now that 100ms has passed since the last update, debounce should have triggered
     expect_equal(rv$d, 2)
@@ -510,7 +508,7 @@ test_that("testModule handles invalidateLater", {
     session$elapse(49)
     expect_equal(rv$x, 1)
 
-    session$elapse(2)
+    session$elapse(1)
     # Should have been incremented now
     expect_equal(rv$x, 2)
   })
diff --git a/vignettes/integration-testing.Rmd b/vignettes/integration-testing.Rmd
index d72fd87af..447fa774c 100644
--- a/vignettes/integration-testing.Rmd
+++ b/vignettes/integration-testing.Rmd
@@ -173,6 +173,49 @@ module <- function(input, output, session){
   })
 ```
 
+## Timer and Polling
+
+Testing behavior that relies on timing is notoriously difficult. Modules will behave differently on different machines and under different conditions. In order to make testing with time more deterministic, `testModule` uses simulated time that you control, rather than the actual computer time. Let's look at what happens when you try to use "real" time in your testing.
+
+```{r}
+module <- function(input, output, session){
+  rv <- reactiveValues(x=0)
+  
+  observe({
+    invalidateLater(100)
+    isolate(rv$x <- rv$x + 1)
+  })
+}
+
+testModule(module, {
+  expect_equal(rv$x, 1) # The observer runs once at initialization
+  
+  Sys.sleep(1) # Sleep for a second
+  
+  expect_equal(rv$x, 1) # The value hasn't changed
+})
+```
+
+This behavior may be surprising. It seems like rv$x should have been incremented 10 times (or perhaps 9, due to computational overhead). But in truth, it hasn't changed at all. This is because `testModule` doesn't consider the actual time on your computer -- only its simulated understanding of time.
+
+In order to cause `testModule` to progress through time, instead of `Sys.sleep`, we'll use `session$elapse` -- another method that exists only on our mocked session object. Using the same module object as above...
+
+```{r}
+testModule(module, {
+  expect_equal(rv$x, 1) # The observer runs once at initialization
+  
+  session$elapse(100) # Elapse 100ms -- just long enough to trigger a reactive invalidation
+  
+  expect_equal(rv$x, 2) # The observer was invalidated and the value updated!
+  
+  # You can even simulate multiple events in a single elapse
+  session$elapse(300)
+  expect_equal(rv$x, 5)
+})
+```
+
+As you can see, using `session$elapse` caused `testModule` to recognize that (simulted) time had passed which triggered the reactivity as we'd expect. This approach allows you to deterministically control time in your tests while avoiding expensive pauses that would slow down your tests. Using this approach, this test can complete in only a fraction of the 100ms that it simulates.
+
 ## Complex Outputs (plots, htmlwidgets)
 
 TODO