tests/testthat/test-HandlerStack.R

In fiery: A Lightweight and Flexible Web Framework

fun1 <- function(...) {
    length(list(...))
}
fun2 <- function(...) {
    ..1
}

test_that("Handlers can be added and removed", {
    stack <- HandlerStack$new()
    fun1 <- function(...) {
        length(list(...))
    }
    fun2 <- function(...) {
        ..1
    }
    stack$add(fun1, 'a')
    stack$add(fun2, 'b')
    expect_equal(stack$length(), 2)
    expect_true(stack$contains('a'))
    expect_true(stack$contains('b'))
    expect_false(stack$contains('c'))
    expect_equal(stack$position('b'), 2)
    expect_equal(stack$position(c('a', 'c')), c(1, NA_integer_))
    
    fun1return <- stack$remove('a')
    expect_equal(stack$length(), 1)
    expect_false(stack$contains('a'))
    expect_true(stack$contains('b'))
    expect_equal(stack$position('b'), 1)
    expect_equal(stack$position(c('a', 'c')), c(NA_integer_, NA_integer_))
    expect_equal(fun1return, fun1)
    
    fun2return <- stack$remove('b')
    expect_equal(stack$length(), 0)
    expect_false(stack$contains('a'))
    expect_false(stack$contains('b'))
    expect_equal(stack$position('b'), NA_integer_)
    expect_equal(fun2return, fun2)
})

test_that('Inserting at position works', {
    stack <- HandlerStack$new()
    stack$add(length, 'length')
    stack$add(str, 'str')
    stack$add(sum, 'sum')
    
    stack$add(min, 'min', 1)
    expect_equal(stack$position('min'), 1)
    
    stack$add(max, 'max', 100)
    expect_equal(stack$position('max'), 5)
    
    stack$add(mean, 'mean', 3)
    expect_equal(stack$position('mean'), 3)
})

test_that('Assertions throw errors', {
    stack <- HandlerStack$new()
    expect_error(stack$add('string', 'id'))
    expect_error(stack$add(c(min, max), 'id'))
    expect_error(stack$add(min, 3))
    expect_error(stack$add(min, 3:5))
    expect_error(stack$add(min, 'min', 'position'))
    expect_error(stack$add(min, 'min', 1:4))
    expect_error(stack(add(min, 'min', 1.5)))
    expect_error(stack$remove(1))
    expect_error(stack$remove(c('1', '2')))
    expect_error(stack$position(1))
    expect_error(stack$contains(1))
})

test_that('Dispatch works', {
    stack <- HandlerStack$new()
    args <- 1:10
    expect_type(stack$dispatch(args), 'list')
    expect_length(stack$dispatch(args), 0)
    expect_named(stack$dispatch(args), character())
    
    stack$add(min, 'min')
    stack$add(mean, 'mean')
    stack$add(max, 'max')
    
    expect_type(stack$dispatch(args), 'list')
    expect_length(stack$dispatch(args), 3)
    expect_named(stack$dispatch(args), c('min', 'mean', 'max'))
    expect_equal(stack$dispatch(args), list(min = min(args), mean = mean(args), max = max(args)))
})