document

R/mock-session.R

@@ -70,8 +70,7 @@ extract <- function(promise) {
 }
 
 #' @noRd
-mapNames <- function(func, ...) {
-  vals <- list(...)
+mapNames <- function(func, vals) {
   names(vals) <- vapply(names(vals), func, character(1))
   vals
 }
@@ -190,20 +189,35 @@ MockShinySession <- R6Class(
       return(paste('data:', contentType, ';base64,', b64, sep=''))
     },
 
-    #' @description Sets reactive values associated with the `session$inputs` object
-    #'   and flushes the reactives.
-    #' @param ... The inputs to set.
+    #' @description Sets reactive values associated with the `session$inputs`
+    #'   object and flushes the reactives.
+    #' @param ... The inputs to set. These arguments are processed with
+    #'   [rlang::list2()] and so are _[dynamic][rlang::dyn-dots]_. Input names
+    #'   may not be duplicated.
     #' @examples
-    #' s <- MockShinySession$new()
-    #' s$setInputs(x=1, y=2)
+    #' \dontrun{
+    #' session$setInputs(x=1, y=2)
+    #' }
     setInputs = function(...) {
-      vals <- list(...)
+      vals <- rlang::dots_list(..., .homonyms = "error")
       mapply(names(vals), vals, FUN = function(name, value) {
         private$.input$set(name, value)
       })
       private$flush()
     },
 
+    #' @description Simulates clicking an action button.
+    #' @param id The id of the button to click.
+    #' @examples
+    #' \dontrun{
+    #' session$click("button1")
+    #' }
+    click = function(id) {
+      val <- (private$.input$get(id) %OR% 0L) + 1L
+      self$setInputs(!!id := val)
+      val
+    },
+
     #' @description An internal method which shouldn't be used by others.
     #' @param millis The number of milliseconds on which to schedule a callback
     #' @param callback The function to schedule
@@ -399,7 +413,10 @@ MockShinySession <- R6Class(
         output = structure(.createOutputWriter(self, ns = ns), class = "shinyoutput"),
         makeScope = function(namespace) self$makeScope(ns(namespace)),
         ns = function(namespace) ns(namespace),
-        setInputs = function(...) do.call(self$setInputs, mapNames(ns, ...))
+        click = function(id) self$click(ns(id)),
+        setInputs = function(...) {
+          self$setInputs(!!!mapNames(ns, rlang::dots_list(..., .homonyms = "error")))
+        }
       )
     },
     #' @description Set the environment associated with a testServer() call, but

man/MockShinySession.Rd

@@ -13,8 +13,17 @@ provided to Shiny server functions or modules.
 ## Method `MockShinySession$setInputs`
 ## ------------------------------------------------
 
-s <- MockShinySession$new()
-s$setInputs(x=1, y=2)
+\dontrun{
+session$setInputs(x=1, y=2)
+}
+
+## ------------------------------------------------
+## Method `MockShinySession$click`
+## ------------------------------------------------
+
+\dontrun{
+session$click("button1")
+}
 }
 \section{Public fields}{
 \if{html}{\out{<div class="r6-fields">}}
@@ -59,6 +68,7 @@ s$setInputs(x=1, y=2)
 \item \href{#method-cycleStartAction}{\code{MockShinySession$cycleStartAction()}}
 \item \href{#method-fileUrl}{\code{MockShinySession$fileUrl()}}
 \item \href{#method-setInputs}{\code{MockShinySession$setInputs()}}
+\item \href{#method-click}{\code{MockShinySession$click()}}
 \item \href{#method-.scheduleTask}{\code{MockShinySession$.scheduleTask()}}
 \item \href{#method-elapse}{\code{MockShinySession$elapse()}}
 \item \href{#method-.now}{\code{MockShinySession$.now()}}
@@ -255,8 +265,8 @@ Base64-encode the given file. Needed for image rendering.
 \if{html}{\out{<a id="method-setInputs"></a>}}
 \if{latex}{\out{\hypertarget{method-setInputs}{}}}
 \subsection{Method \code{setInputs()}}{
-Sets reactive values associated with the \code{session$inputs} object
-and flushes the reactives.
+Sets reactive values associated with the \code{session$inputs}
+object and flushes the reactives.
 \subsection{Usage}{
 \if{html}{\out{<div class="r">}}\preformatted{MockShinySession$setInputs(...)}\if{html}{\out{</div>}}
 }
@@ -264,14 +274,44 @@ and flushes the reactives.
 \subsection{Arguments}{
 \if{html}{\out{<div class="arguments">}}
 \describe{
-\item{\code{...}}{The inputs to set.}
+\item{\code{...}}{The inputs to set. These arguments are processed with
+\code{\link[rlang:list2]{rlang::list2()}} and so are \emph{\link[rlang:dyn-dots]{dynamic}}. Input names
+may not be duplicated.}
 }
 \if{html}{\out{</div>}}
 }
 \subsection{Examples}{
 \if{html}{\out{<div class="r example copy">}}
-\preformatted{s <- MockShinySession$new()
-s$setInputs(x=1, y=2)
+\preformatted{\dontrun{
+session$setInputs(x=1, y=2)
+}
+}
+\if{html}{\out{</div>}}
+
+}
+
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-click"></a>}}
+\if{latex}{\out{\hypertarget{method-click}{}}}
+\subsection{Method \code{click()}}{
+Simulates clicking an action button.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$click(id)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{id}}{The id of the button to click.}
+}
+\if{html}{\out{</div>}}
+}
+\subsection{Examples}{
+\if{html}{\out{<div class="r example copy">}}
+\preformatted{\dontrun{
+session$click("button1")
+}
 }
 \if{html}{\out{</div>}}
 

tests/testthat/test-test-server.R

@@ -61,10 +61,7 @@ test_that("testServer handles observers", {
 })
 
 test_that("inputs aren't directly assignable", {
-  module <- function(id) {
-    moduleServer(id, function(input, output, session) {
-    })
-  }
+  module <- function(id) moduleServer(id, function(input, output, session) {})
 
   testServer(module, {
     session$setInputs(x = 0)
@@ -73,6 +70,48 @@ test_that("inputs aren't directly assignable", {
   })
 })
 
+test_that("inputs can be incremented like actionButtons with session$click", {
+  module <- function(id) {
+    moduleServer(id, function(input, output, session) {
+      num_clicks <- reactiveVal(0)
+    })
+  }
+
+  testServer(module, {
+    expect_null(input$button1)
+    expect_equal(num_clicks(), 0)
+
+    observeEvent(input$button1, num_clicks(num_clicks() + 1))
+
+    newv <- session$click("button1")
+    expect_equal(newv, 1)
+    expect_equal(input$button1, 1)
+    expect_equal(num_clicks(), 1)
+
+    for (i in 1:10) session$click("button1")
+    expect_equal(input$button1, 11)
+    expect_equal(num_clicks(), 11)
+  })
+})
+
+test_that("setInputs dots are dynamic", {
+  module <- function(id) moduleServer(id, function(input, output, session) {})
+
+  inputs_initial <- list(x=1, y=2)
+  input_y <- "y"
+
+  testServer(module, {
+    session$setInputs(!!!inputs_initial)
+    expect_equal(input$x, 1)
+    expect_equal(input$y, 2)
+    session$setInputs(!!input_y := 3)
+    expect_equal(input$y, 3)
+
+    # Duplicate names are an error
+    expect_error(session$setInputs(x = 1, x = 2))
+  })
+})
+
 test_that("testServer handles more complex expressions", {
   module <- function(id) {
     moduleServer(id, function(input, output, session){