rasynchronousshinytestthat

Testing async ExtendedTask with shinytest2


I am trying to migrate some slow running functions to use the new ExtentedTask feature but cannot find a way to make {shinytest2} wait for the results of the functions to be available. I've tried adding Sys.sleep(8) (longer than the slow function) prior to running app$get_value(export = "async") but the result is still NULL and also using app$wait_for_value(export = "async") but it timeouts even though timeout is set to 10 seconds. MRE below.

library(testthat)
library(shiny)
library(shinytest2)
library(bslib)
library(future)
library(promises)

test_that("aysnc shinytest2", {

plan(multisession)

ui <- fluidPage(
  actionButton("run_normal", "Run normal"),
  textOutput("normal_result"),
  input_task_button("run_async", "Run async"),
  textOutput("async_result")
)

server <- function(input, output, session) {

  slow_function <- function(){
    Sys.sleep(5)
    return(10)
  }

  task <- ExtendedTask$new(function() {
    future_promise({
      slow_function()
    })
  }) |> bind_task_button("run_async")

  returned_value <- reactiveValues()

  observeEvent(input$run_normal, {
    returned_value$normal <- slow_function()
  })

  output$normal_result <- renderText({
    req(returned_value$normal)
    returned_value$normal
  })

  observeEvent(input$run_async, {
    task$invoke()
  })

  observe({
    returned_value$async <- task$result()
  })

  output$async_result <- renderText({
    req(returned_value$async)
    returned_value$async
  })

  exportTestValues(async = returned_value$async,
                   normal = returned_value$normal)

}

shiny_app <- shinyApp(ui = ui, server = server)

app <- AppDriver$new(shiny_app, timeout = 10000)
app$click("run_normal")
normal_result <- app$get_value(export = "normal")
expect_equal(normal_result, 10)

app <- AppDriver$new(shiny_app, timeout = 10000)
app$click("run_async")
async_result <- app$get_value(export = "async")
expect_equal(async_result, 10)
})

Solution

  • It looks like app$click("run_async") does nothing. But app$click(selector = "#run_async") does something. In addition, one has to use future instead of future_promise.

    ......
      task <- ExtendedTask$new(function() {
        future({
          slow_function()
        })
      }) |> bind_task_button("run_async")
    ......
    
    app <- AppDriver$new(shiny_app)
    app$click(selector = "#run_async")
    app$click("run_normal")
    str(app$get_values())
    

    gives:

    List of 3
     $ input :List of 2
      ..$ run_async : 'shinyActionButtonValue' int 1
      ..$ run_normal: 'shinyActionButtonValue' int 1
     $ output:List of 2
      ..$ async_result : chr "10"
      ..$ normal_result: chr "10"
     $ export:List of 2
      ..$ async : num 10
      ..$ normal: num 10