tests/testthat/test-plugin-perf.R

In tjpalanca/webtools: Web Server Tools

test_that("Performance tools work", {

  # Application
  app <- expect_r6(App$new(PerfPlugin$new()), "App")

  # Request router
  app$router("/", function(request, response, keys, ...) {
    Sys.sleep(2L)
    response$body <- runif(1L)
    Sys.sleep(2L)
    app$set_data("response", response$body)
    Sys.sleep(2L)
    return(FALSE)
  })
  expect_class(app$perf$profile("/"), "profvis")
  expect_class(app$perf$profile("/", router = "/"), "profvis")
  expect_number(app$get_data("response"))
  expect_class(app$perf$benchmark("/", times = 2L), "microbenchmark")

  # Header Router
  app$router("/", attach = "header", function(request, response, keys, ...) {
    Sys.sleep(3L)
    app$set_data("header", Sys.time())
    Sys.sleep(3L)
    return(TRUE)
  })
  expect_class(app$perf$profile("/"), "profvis")
  time <- expect_posixct(app$get_data("header"))
  expect_class(
    app$perf$profile("/", router = "/", attach = "header"),
    "profvis"
  )
  time <- expect_gt(app$get_data("header"), time)

  # Message Router
  app$set_path_extractor(function(msg, bin) msg$path)
  app$router(
    "/ws/message",
    attach = "message",
    function(request, response, keys, ...) {
      Sys.sleep(3L)
      app$set_data("message", request$body$message)
      Sys.sleep(3L)
      return(FALSE)
    }
  )
  message <- stri_rand_strings(1, 12)
  expect_class(
    app$perf$profile(
      message = list(path = "/ws/message", message = message),
      attach = "message"
    ),
    "profvis"
  )
  expect_equal(app$get_data("message"), message)
  message <- stri_rand_strings(1, 12)
  expect_class(
    app$perf$benchmark(
      message = list(path = "/ws/message", message = message),
      attach  = "message",
      times   = 2L
    ),
    "microbenchmark"
  )
  expect_equal(app$get_data("message"), message)

  # Load testing
  if (isAvailable()) {
    app <- App$new(PerfPlugin$new(), logger = logger_null())
    app$router("/", function(request, response, keys, ...) {
      response$status_with_text(200L)
      return(FALSE)
    })
    stop_all()
    expect_error(app$perf$load_test("/", threads = 1L, loops = 10L), NA)
    stop_all()
  }

})