Testing Shiny applications

Lesson 9 — R Shiny

Lesson 9 of 11 Advanced ~80 min

Learning objectives

  • Separate business logic from reactive plumbing so it can be tested plainly
  • Test server logic and modules with testServer()
  • Write end-to-end browser tests with shinytest2
  • Use snapshot testing for UI and output regression
  • Run Shiny tests in continuous integration

Three layers

┌─────────────────────────────────────────────┐
│  End-to-end (shinytest2)                    │  slow, few
│  Real browser, real clicks, screenshots     │
├─────────────────────────────────────────────┤
│  Server logic (testServer)                  │  fast, many
│  Reactives, modules, no browser             │
├─────────────────────────────────────────────┤
│  Pure functions (testthat)                  │  fastest, most
│  Derivations, formatting, validation        │
└─────────────────────────────────────────────┘

The most valuable thing you can do for Shiny testability happens before you write any test: move logic out of the server.

# HARD TO TEST — logic tangled with reactivity
server <- function(input, output, session) {
  output$table <- renderTable({
    d <- adsl
    if (input$arm != "All") d <- d[d$TRT01P == input$arm, ]
    d <- d[d$AGE >= input$age[1] & d$AGE <= input$age[2], ]
    aggregate(AGE ~ TRT01P, d, function(x) c(n = length(x), mean = mean(x)))
  })
}

# EASY TO TEST — a plain function
filter_subjects <- function(data, arm = "All", age_range = c(0, 120)) {
  if (arm != "All") data <- dplyr::filter(data, TRT01P == arm)
  dplyr::filter(data, AGE >= age_range[1], AGE <= age_range[2])
}

summarise_by_arm <- function(data) {
  dplyr::summarise(data, n = dplyr::n(), mean_age = mean(AGE, na.rm = TRUE),
                   .by = TRT01P)
}

server <- function(input, output, session) {
  filtered <- reactive(filter_subjects(adsl, input$arm, input$age))
  output$table <- renderTable(summarise_by_arm(filtered()))
}

filter_subjects() and summarise_by_arm() are now testable with ordinary testthat — no Shiny involved. See Testing with testthat.

testServer()

Tests the server function without a browser. Fast enough to run on every save.

library(testthat)
library(shiny)

test_that("filtering by arm reduces the row count", {
  testServer(server, {
    session$setInputs(arm = "Placebo", age = c(18, 90), saffl = TRUE)

    expect_true(all(filtered()$TRT01P == "Placebo"))
    expect_lt(nrow(filtered()), nrow(adsl))
  })
})

test_that("the age filter is inclusive at both ends", {
  testServer(server, {
    session$setInputs(arm = "All", age = c(65, 65), saffl = FALSE)
    expect_true(all(filtered()$AGE == 65))
  })
})

test_that("outputs update when inputs change", {
  testServer(server, {
    session$setInputs(arm = "All", age = c(18, 90), saffl = TRUE)
    n_all <- output$n_subj

    session$setInputs(arm = "Placebo")
    expect_lt(as.numeric(output$n_subj), as.numeric(n_all))
  })
})

Inside testServer() you have access to:

session$setInputs(x = 1, y = 2)     # set inputs (triggers reactivity)
input$x                             # read an input
output$plot                         # read a rendered output
some_reactive()                     # call any reactive in the server
session$flushReact()                # force pending reactions to run
session$elapse(1000)                # advance time for invalidateLater/debounce
session$getReturned()               # a module's return value
session$returned                    # same

Testing a module

test_that("mod_filter_server returns correctly filtered data", {
  test_data <- reactive(tibble::tribble(
    ~USUBJID, ~TRT01P,   ~AGE, ~SAFFL,
    "001",    "Placebo",  45,   "Y",
    "002",    "Drug A",   72,   "Y",
    "003",    "Drug A",   38,   "N",
    "004",    "Placebo",  67,   "Y"
  ))

  testServer(mod_filter_server, args = list(data = test_data), {

    session$setInputs(arm = "All", age = c(18, 90), saffl = FALSE)
    expect_equal(nrow(session$getReturned()()), 4)

    session$setInputs(arm = "Drug A")
    expect_equal(nrow(session$getReturned()()), 2)

    session$setInputs(arm = "All", saffl = TRUE)
    expect_equal(nrow(session$getReturned()()), 3)
    expect_false("003" %in% session$getReturned()()$USUBJID)

    session$setInputs(age = c(60, 90))
    expect_equal(session$getReturned()()$USUBJID, c("002", "004"))
  })
})

session$getReturned() gives the module’s return value. Because it is a reactive, you call it: session$getReturned()().

Testing state and events

test_that("the counter increments and resets", {
  testServer(server, {
    expect_equal(counter(), 0)

    session$setInputs(increment = 1)   # action buttons: set the click count
    expect_equal(counter(), 1)

    session$setInputs(increment = 2)
    expect_equal(counter(), 2)

    session$setInputs(reset = 1)
    expect_equal(counter(), 0)
  })
})

test_that("debounced input settles after the delay", {
  testServer(server, {
    session$setInputs(search = "abc")
    expect_null(debounced_search())     # not yet

    session$elapse(600)                 # advance past the 500ms debounce
    expect_equal(debounced_search(), "abc")
  })
})

Testing an error path

test_that("an empty filter result produces a validation message", {
  testServer(server, {
    session$setInputs(arm = "Nonexistent", age = c(18, 90))

    expect_equal(nrow(filtered()), 0)
    expect_error(output$plot, "No subjects match")
  })
})
WarningWhat testServer() cannot do
  • No browser, so no JavaScript — shinyjs, conditionalPanel and DT client-side behaviour are all invisible
  • renderUI() output is a tag object, not rendered HTML
  • Inputs created by renderUI() do not exist until you setInputs() them manually
  • No layout, no CSS, no screenshots

For those, you need shinytest2.

shinytest2

Drives a real headless browser (Chromote). Slower, but tests what the user actually experiences.

usethis::use_package("shinytest2", "Suggests")
shinytest2::use_shinytest2()
library(shinytest2)

test_that("the app loads and filtering updates the outputs", {
  app <- AppDriver$new(
    app_dir = test_path("../.."),
    name    = "adsl-explorer",
    height  = 900, width = 1400,
    seed    = 42                       # make any randomness reproducible
  )

  # Initial state
  app$wait_for_idle()
  app$expect_values(output = c("n_subj", "mean_age"))

  # Interact
  app$set_inputs(arm = "Placebo")
  app$wait_for_idle()
  expect_lt(as.numeric(app$get_value(output = "n_subj")), 300)

  app$set_inputs(age = c(65, 90))
  app$wait_for_idle()
  app$expect_values(output = "n_subj")

  # Visual regression
  app$expect_screenshot(name = "placebo-elderly")

  # Click a button
  app$click("reset")
  app$wait_for_idle()
  expect_equal(app$get_value(input = "arm"), "All")

  app$stop()
})

Key methods:

app$set_inputs(x = 1, y = "a", wait_ = TRUE)
app$click("button_id")
app$upload_file(file = "test-data.csv")
app$get_value(input = "x"); app$get_value(output = "plot")
app$get_values()                       # everything
app$wait_for_idle(duration = 200, timeout = 30000)
app$wait_for_value(output = "table", ignore = list(NULL))
app$expect_values()                    # snapshot of all inputs/outputs
app$expect_screenshot()
app$expect_download("download_csv")
app$get_logs()                         # browser console + R messages
app$view()                             # open the live browser — for debugging
app$stop()

Recording a test

shinytest2::record_test()

Opens the app in a browser with a recording panel. Click through the workflow, add expectations, and it generates the test file. This is by far the fastest way to write the first version of an end-to-end test; edit it afterwards to remove noise.

Snapshots

expect_values() writes a JSON snapshot of inputs and outputs; expect_screenshot() writes a PNG.

testthat::snapshot_review()     # visual diff of what changed
testthat::snapshot_accept()     # accept the new state
TipScreenshots are brittle across platforms

Font rendering differs between macOS, Windows and Linux, so a screenshot taken on your laptop will not match the one taken in CI. Options:

  • Run screenshot tests only on one platform (skip_on_os())
  • Use expect_values() (JSON) for CI and screenshots locally
  • Run CI in the same container you develop in

expect_values() is much more robust and catches most regressions. Reserve screenshots for layout-critical apps.

Testing downloads

test_that("the CSV export contains the filtered rows", {
  app <- AppDriver$new(app_dir = test_path("../.."))
  app$set_inputs(arm = "Placebo")
  app$wait_for_idle()

  path <- app$get_download("download_csv")
  d <- readr::read_csv(path, show_col_types = FALSE)

  expect_true(all(d$TRT01P == "Placebo"))
  expect_gt(nrow(d), 0)

  app$stop()
})

Testing uploads

test_that("uploading a valid CSV populates the table", {
  app <- AppDriver$new(app_dir = test_path("../.."))

  app$upload_file(file = test_path("fixtures", "valid_adsl.csv"))
  app$wait_for_idle()
  expect_gt(as.numeric(app$get_value(output = "n_rows")), 0)

  app$stop()
})

test_that("uploading a file without USUBJID shows an error", {
  app <- AppDriver$new(app_dir = test_path("../.."))

  app$upload_file(file = test_path("fixtures", "missing_usubjid.csv"))
  app$wait_for_idle()

  expect_match(app$get_value(output = "table"), "USUBJID")

  app$stop()
})

Continuous integration

# .github/workflows/shiny-tests.yaml
name: Shiny tests

on: [push, pull_request]

jobs:
  test:
    runs-on: ubuntu-latest
    env:
      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
    steps:
      - uses: actions/checkout@v4

      - uses: r-lib/actions/setup-r@v2
        with:
          use-public-rspm: true

      - uses: r-lib/actions/setup-r-dependencies@v2
        with:
          extra-packages: |
            any::shinytest2
            any::testthat
            any::rcmdcheck

      - name: Run tests
        run: |
          shiny::runTests(".", assert = TRUE)
        shell: Rscript {0}

      - name: Upload failure artefacts
        if: failure()
        uses: actions/upload-artifact@v4
        with:
          name: test-snapshots
          path: tests/testthat/_snaps/

Uploading _snaps/ on failure is the detail that makes CI failures diagnosable — you get the actual screenshot or JSON that differed, rather than just a message saying it did.

A testing strategy

Layer What How many Speed
Pure functions Derivations, formatting, validation Dozens Milliseconds
testServer Reactive wiring, modules, state Tens Seconds
shinytest2 Critical user journeys A handful Minutes

The critical journeys worth an end-to-end test:

  1. App loads without error
  2. The primary workflow produces a result
  3. Upload → process → download round trip
  4. Authorisation: a restricted user cannot reach restricted data
  5. The error path: bad input produces a message, not a crash

Everything else should be pushed down to the faster layers.

Common mistakes

Mistake Consequence Fix
All logic inside render functions Untestable Extract pure functions
Only end-to-end tests Slow, flaky suite Push tests down the pyramid
No wait_for_idle() Flaky, race-dependent Wait after every interaction
Screenshot tests in CI Fail on font differences expect_values(), or pin the platform
Testing implementation Breaks on every refactor Test observable behaviour
Unseeded randomness Non-reproducible snapshots seed = in AppDriver$new()
No test for the empty case Crashes on real data Test zero-row results

Exercise 9.1 — Make an app testable

Refactor this server so the logic can be tested without Shiny, then write both the pure-function tests and a testServer() test.

server <- function(input, output, session) {
  output$summary <- renderTable({
    d <- adsl[adsl$TRT01P == input$arm, ]
    data.frame(
      n        = nrow(d),
      mean_age = round(mean(d$AGE, na.rm = TRUE), 1),
      pct_female = round(100 * mean(d$SEX == "F", na.rm = TRUE), 1)
    )
  })
}
Show solution

Step 1 — extract the logic.

# R/summarise.R

#' Summarise a subject-level dataset
#' @param data A data frame with AGE and SEX columns.
#' @return A one-row data frame with n, mean_age and pct_female.
#' @export
summarise_subjects <- function(data) {
  data.frame(
    n          = nrow(data),
    mean_age   = if (nrow(data) == 0) NA_real_
                 else round(mean(data$AGE, na.rm = TRUE), 1),
    pct_female = if (nrow(data) == 0) NA_real_
                 else round(100 * mean(data$SEX == "F", na.rm = TRUE), 1)
  )
}

#' @export
filter_arm <- function(data, arm) {
  if (identical(arm, "All")) return(data)
  data[data$TRT01P == arm & !is.na(data$TRT01P), , drop = FALSE]
}
# app.R
server <- function(input, output, session) {
  filtered <- reactive(filter_arm(adsl, input$arm))
  output$summary <- renderTable(summarise_subjects(filtered()))
}

Step 2 — pure function tests (fast, exhaustive).

test_data <- tibble::tribble(
  ~USUBJID, ~TRT01P,   ~AGE, ~SEX,
  "001",    "Placebo",  45,  "F",
  "002",    "Placebo",  55,  "M",
  "003",    "Drug A",   65,  "F",
  "004",    "Drug A",   NA,  "F"
)

test_that("filter_arm keeps only the requested arm", {
  expect_equal(nrow(filter_arm(test_data, "Placebo")), 2)
  expect_equal(nrow(filter_arm(test_data, "Drug A")), 2)
  expect_equal(nrow(filter_arm(test_data, "All")), 4)
  expect_equal(nrow(filter_arm(test_data, "Nonexistent")), 0)
})

test_that("summarise_subjects computes n, mean age and percent female", {
  out <- summarise_subjects(filter_arm(test_data, "Placebo"))
  expect_equal(out$n, 2)
  expect_equal(out$mean_age, 50)
  expect_equal(out$pct_female, 50)
})

test_that("missing ages are excluded from the mean", {
  out <- summarise_subjects(filter_arm(test_data, "Drug A"))
  expect_equal(out$n, 2)          # both subjects counted
  expect_equal(out$mean_age, 65)  # only one contributes to the mean
  expect_equal(out$pct_female, 100)
})

test_that("an empty dataset returns NA rather than NaN", {
  out <- summarise_subjects(test_data[0, ])
  expect_equal(out$n, 0)
  expect_true(is.na(out$mean_age))
  expect_true(is.na(out$pct_female))
})

That last test is the one worth having. Without the if (nrow(data) == 0) guard, mean(numeric(0)) returns NaN and the table shows NaN to the user.

Step 3 — testServer for the wiring.

test_that("the summary output responds to the arm input", {
  testServer(server, {
    session$setInputs(arm = "Placebo")
    expect_equal(nrow(filtered()), 2)

    session$setInputs(arm = "All")
    expect_equal(nrow(filtered()), 4)
  })
})
Notice how thin the testServer test is. All the interesting behaviour was tested in step 2 at a fraction of the cost; step 3 only confirms the wiring. That ratio is the goal.

Exercise 9.2 — End-to-end journey

Write a shinytest2 test for the journey: upload a CSV → apply a filter → verify the row count → download the result → verify the downloaded file matches the filter.

Show solution 
library(shinytest2)

test_that("upload, filter and download round trip", {
  skip_on_cran()

  # --- Fixture ------------------------------------------------------------
  fixture <- withr::local_tempfile(fileext = ".csv")
  test_data <- data.frame(
    USUBJID = sprintf("%03d", 1:20),
    TRT01P  = rep(c("Placebo", "Drug A"), each = 10),
    AGE     = c(seq(40, 76, by = 4), seq(45, 81, by = 4)),
    SEX     = rep(c("M", "F"), 10),
    SAFFL   = "Y"
  )
  readr::write_csv(test_data, fixture)

  app <- AppDriver$new(
    app_dir = test_path("../.."),
    name    = "upload-filter-download",
    seed    = 42,
    height  = 900, width = 1400
  )
  on.exit(app$stop(), add = TRUE)

  # --- 1. Upload ----------------------------------------------------------
  app$upload_file(file = fixture)
  app$wait_for_idle(timeout = 15000)

  expect_equal(as.numeric(app$get_value(output = "n_rows")), 20)

  # --- 2. Filter ----------------------------------------------------------
  app$set_inputs(arm = "Placebo")
  app$wait_for_idle()

  expect_equal(as.numeric(app$get_value(output = "n_rows")), 10)

  app$set_inputs(age = c(50, 70))
  app$wait_for_idle()

  n_shown <- as.numeric(app$get_value(output = "n_rows"))
  expected <- sum(test_data$TRT01P == "Placebo" &
                  test_data$AGE >= 50 & test_data$AGE <= 70)
  expect_equal(n_shown, expected)

  # --- 3. Download and verify --------------------------------------------
  downloaded <- app$get_download("download_csv")
  result <- readr::read_csv(downloaded, show_col_types = FALSE)

  expect_equal(nrow(result), expected)
  expect_true(all(result$TRT01P == "Placebo"))
  expect_true(all(result$AGE >= 50 & result$AGE <= 70))
  expect_setequal(names(result), names(test_data))

  # --- 4. No errors in the console ---------------------------------------
  logs <- app$get_logs()
  errors <- logs[logs$level %in% c("error", "SEVERE"), ]
  expect_equal(nrow(errors), 0,
               info = paste(errors$message, collapse = "\n"))
})

Points that make this a useful test rather than a fragile one:

  • The expected count is computed from the fixture, not hard-coded. If the fixture changes, the test still asserts the right thing.
  • wait_for_idle() after every interaction. Without it, the assertion may read a stale output and the test fails intermittently — the worst kind of failure.
  • The download is verified against the filter, not just checked for existence. “The download button produces a file” is a much weaker statement than “the file contains exactly the filtered rows”, and the second is the one that catches the bug where the handler forgets the filter (see Authentication).
  • Console errors are checked. A JavaScript error that does not break the visible behaviour will otherwise go unnoticed until it does.
  • No screenshot, so this runs reliably in CI on any platform.

Recap

  • Extract logic into pure functions first; that is the biggest testability win
  • testServer() for reactives and modules — fast, no browser
  • session$getReturned()() to test a module’s return value
  • session$elapse() to test debounce and invalidateLater
  • shinytest2 for a handful of critical end-to-end journeys
  • wait_for_idle() after every interaction, or the suite will be flaky
  • Prefer expect_values() over screenshots in CI
  • Upload _snaps/ as a CI artefact so failures are diagnosable

Next: Deployment.

Back to top