tests/testthat/test-update_page_title.R

mock_session <- function() {
  state <- new.env(parent = emptyenv())
  state$messages <- list()
  list(
    sendCustomMessage = function(type, message) {
      state$messages <- c(
        state$messages,
        list(list(type = type, message = message))
      )
      invisible(NULL)
    },
    messages = function() state$messages
  )
}

test_that("update_page_title sends the page_title only", {
  session <- mock_session()
  update_page_title(session, page_title = "Summary")
  msgs <- session$messages()
  expect_length(msgs, 1)
  expect_equal(msgs[[1]]$type, "update_page_title")
  expect_equal(msgs[[1]]$message, "Summary")
})

test_that("update_page_title composes '<page_title> | <service_name>'", {
  session <- mock_session()
  update_page_title(
    session,
    page_title = "Summary",
    service_name = "My service"
  )
  msgs <- session$messages()
  expect_length(msgs, 1)
  expect_equal(msgs[[1]]$message, "Summary | My service")
})

test_that("update_page_title treats empty service_name like NULL", {
  session <- mock_session()
  update_page_title(session, page_title = "Summary", service_name = "")
  msgs <- session$messages()
  expect_length(msgs, 1)
  expect_equal(msgs[[1]]$message, "Summary")
})

test_that("update_page_title runs without error for both call shapes", {
  session <- mock_session()
  expect_no_error(update_page_title(session, page_title = "Page"))
  expect_no_error(
    update_page_title(session, page_title = "Page", service_name = "Service")
  )
})

test_that("update_page_title errors on missing or empty page_title", {
  session <- mock_session()
  expect_error(update_page_title(session, page_title = NULL))
  expect_error(update_page_title(session, page_title = character(0)))
  expect_error(update_page_title(session, page_title = ""))
})

test_that("update_page_title.js registers a handler for the message it sends", {
  # update_page_title() is only ever exercised end-to-end via
  # service_navigation.js's own title-sync path (a separate code path), so
  # nothing else catches a mismatch between the message name sent here and
  # the name the browser handler listens for. Guard against that directly.
  js_path <- system.file(
    "www",
    "js",
    "update_page_title.js",
    package = "shinyGovstyle"
  )
  expect_true(file.exists(js_path))
  js <- paste(readLines(js_path, warn = FALSE), collapse = "\n")

  expect_match(
    js,
    'Shiny\\.addCustomMessageHandler\\(\\s*"update_page_title"',
    perl = TRUE
  )
})

Try the shinyGovstyle package in your browser

Any scripts or data that you put into this service are public.

shinyGovstyle documentation built on Oct. 16, 2026, 1:07 a.m.