1library(shiny)
2library(testthat)
3
4test_that("testServer works with dir app", {
5  # app.R
6  testServer(test_path("..", "test-modules", "06_tabsets"), {
7    session$setInputs(dist="norm", n=5)
8    expect_length(d(), 5)
9
10    session$setInputs(dist="unif", n=6)
11    expect_length(d(), 6)
12  })
13
14  # server.R
15  testServer(test_path("..", "test-modules", "server_r"), {
16    session$setInputs(dist="norm", n=5)
17    expect_length(d(), 5)
18
19    session$setInputs(dist="unif", n=6)
20    expect_length(d(), 6)
21  })
22})
23
24test_that("testServer works when referencing external globals", {
25  # If global is defined at the top of app.R outside of the server function.
26  testServer(test_path("..", "test-modules", "06_tabsets"), {
27    expect_equal(get("global", session$env), 123)
28  })
29})
30
31test_that("testServer defaults to the app at .", {
32  curwd <- getwd()
33  on.exit(setwd(curwd))
34  setwd(test_path("..", "test-modules", "06_tabsets"))
35  testServer(expr = {
36    expect_equal(get("global", session$env), 123)
37  })
38})
39
40test_that("runTests works with a dir app that calls modules and uses testServer", {
41  app <- test_path("..", "test-modules", "12_counter")
42  run <- testthat::expect_output(
43    print(runTests(app)),
44    "Shiny App Test Results\\n\\* Success\\n  - 12_counter/tests/testthat\\.R"
45  )
46  expect_true(all(run$pass))
47})
48
49test_that("runTests works with a dir app that calls modules that return reactives and use brushing", {
50  app <- test_path("..", "test-modules", "107_scatterplot")
51  run <- testthat::expect_output(
52    print(runTests(app)),
53    "Shiny App Test Results\\n\\* Success\\n  - 107_scatterplot/tests/testthat\\.R"
54  )
55  expect_true(all(run$pass))
56})
57
58test_that("a Shiny app object with a module inside can be tested", {
59
60  counterUI <- function(id, label = "Counter") {
61    ns <- NS(id)
62    tagList(
63      actionButton(ns("button"), label = label),
64      verbatimTextOutput(ns("out"))
65    )
66  }
67
68  counterServer <- function(id) {
69    moduleServer(
70      id,
71      function(input, output, session) {
72        count <- reactiveVal(0)
73        observeEvent(input$button, {
74          count(count() + 1)
75        })
76        output$out <- renderText({
77          count()
78        })
79        count
80      }
81    )
82  }
83
84  ui <- fluidPage(
85    textInput("number", "A number"),
86    textOutput("numberDoubled"),
87    counterUI("counter1", "Counter #1"),
88    counterUI("counter2", "Counter #2")
89  )
90  server <- function(input, output, session) {
91    counterServer("counter1")
92    counterServer("counter2")
93    doubled <- reactive( { as.integer(input$number) * 2 })
94    output$numberDoubled <- renderText({ doubled() })
95  }
96  app <- shinyApp(ui, server)
97
98  testServer(app, {
99    session$setInputs(number = "42")
100    expect_equal(doubled(), 84)
101  })
102})
103
104test_that("It's an error to pass arguments to a server", {
105  expect_error(testServer(test_path("..", "test-modules", "06_tabsets"), {}, args = list(an_arg = 123)))
106})
107