tests/testthat/test-input.R

describe("make_inputs_impl", {
  expected_inputs <- function(func) as.list(formals(func))
  it("should allow no inputs", {
    inputs <- make_inputs_impl()
    expected <- expected_inputs(function() {})
    expect_equal(inputs, expected)
  })

  it("should allow inputs without default values", {
    inputs <- make_inputs_impl(x)
    expected <- expected_inputs(function(x) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x, y)
    expected <- expected_inputs(function(x, y) {})
    expect_equal(inputs, expected)
  })

  it("should allow inputs with default values", {
    inputs <- make_inputs_impl(x = 10)
    expected <- expected_inputs(function(x = 10) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x = 10, y = "test")
    expected <- expected_inputs(function(x = 10, y = "test") {})
    expect_equal(inputs, expected)
  })

  it("should allow NULL default values", {
    inputs <- make_inputs_impl(x = NULL)
    expected <- expected_inputs(function(x = NULL) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x = NULL, y = NULL)
    expected <- expected_inputs(function(x = NULL, y = NULL) {})
    expect_equal(inputs, expected)
  })

  it("should allow inputs with and without default values", {
    inputs <- make_inputs_impl(x = "x", y)
    expected <- expected_inputs(function(x = "x", y) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x, y = TRUE)
    expected <- expected_inputs(function(x, y = TRUE) {})
    expect_equal(inputs, expected)
  })

  it("should not evaluate expressions, but quote them", {
    inputs <- make_inputs_impl(x = 1:3)
    expected <- expected_inputs(function(x = 1:3) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x = a + b)
    expected <- expected_inputs(function(x = a + b) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x = 10, y = x + 20)
    expected <- expected_inputs(function(x = 10, y = x + 20) {})
    expect_equal(inputs, expected)
  })

  it("should allow trailing comma", {
    inputs <- make_inputs_impl(x, )
    expected <- expected_inputs(function(x) {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x = "hello", )
    expected <- expected_inputs(function(x = "hello") {})
    expect_equal(inputs, expected)

    inputs <- make_inputs_impl(x, y, )
    expected <- expected_inputs(function(x, y) {})
    expect_equal(inputs, expected)
  })

  it("should error for missing args", {
    expect_error({
      make_inputs_impl(x, , y)
    })

    expect_error({
      make_inputs_impl(x = )
    })

    expect_error({
      make_inputs_impl(x = , y)
    })

    expect_error({
      make_inputs_impl(x, y =)
    })

    expect_error({
      make_inputs_impl(x, y = , z)
    })
  })

  it("should error for not symbol names", {
    expect_error({
      make_inputs_impl("a")
    })

    expect_error({
      make_inputs_impl(1L)
    })

    expect_error({
      make_inputs_impl(TRUE)
    })

    expect_error({
      make_inputs_impl(1.0)
    })

    expect_error({
      make_inputs_impl(as.Date('2018-01-01'))
    })

    expect_error({
      make_inputs_impl(1:3)
    })

    expect_error({
      make_inputs_impl(c(1, 2, 3))
    })
  })
})

describe("update_inputs_impl", {
  it("should return the old if new is empty", {
    old <- make_inputs_impl(x, y)
    new <- list()
    inputs <- update_inputs_impl(old, new)
    expected <- old
    expect_equal(inputs, expected)
  })

  it("should be able to add a value to an existing input", {
    old <- make_inputs_impl(x)
    new <- make_inputs_impl(x = 10)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x, y)
    new <- make_inputs_impl(x = 10)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x = 10, y)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x, y)
    new <- make_inputs_impl(y = 10)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y = 10)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10)
    new <- make_inputs_impl(x = 20)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10, y)
    new <- make_inputs_impl(y = x + 10)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x = 10, y = x + 10)
    expect_equal(inputs, expected)
  })

  it("should allow setting NULL as the new value", {
    old <- make_inputs_impl()
    new <- make_inputs_impl(x = NULL)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    new <- make_inputs_impl(x = NULL)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x, y)
    new <- make_inputs_impl(x = NULL)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x = NULL, y)
    expect_equal(inputs, expected)
  })

  it("should be able to remove a value from an existing input", {
    old <- make_inputs_impl(x = 10)
    new <- make_inputs_impl(x)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10, y)
    new <- make_inputs_impl(x)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10, y = "hello")
    new <- make_inputs_impl(y)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x = 10, y)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10, y = "hello")
    new <- make_inputs_impl(y, x)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y)
    expect_equal(inputs, expected)
  })

  it("should return the old if new values are the same", {
    old <- make_inputs_impl(x = 10, y = "hello")
    new <- make_inputs_impl(x = 10, y = "hello")
    inputs <- update_inputs_impl(old, new)
    expect_equal(inputs, old)
    expect_equal(inputs, new)

    old <- make_inputs_impl(x = 10, y = "hello")
    new <- make_inputs_impl(y = "hello", x = 10)
    inputs <- update_inputs_impl(old, new)
    expect_equal(inputs, old)
  })

  it("should allow adding and removing values at the same time", {
    old <- make_inputs_impl(x = 10)
    new <- make_inputs_impl(x, y = 20)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y = 20)
    expect_equal(inputs, expected)
  })

  it("should be able to add a new input", {
    old <- make_inputs_impl()
    new <- make_inputs_impl(x = 20)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    new <- make_inputs_impl(y = 20)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y = 20)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    new <- make_inputs_impl(y = 20, z = 30)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y = 20, z = 30)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    new <- make_inputs_impl(y)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    new <- make_inputs_impl(y, z = "abc")
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, y, z = "abc")
    expect_equal(inputs, expected)
  })

  it("should be able to add and update inputs at the same time", {
    old <- make_inputs_impl(x)
    new <- make_inputs_impl(x = rlang::zap(), y = 10)
    inputs <- update_inputs_impl(old, new)
    expected <- new
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10)
    new <- make_inputs_impl(x, a = "a", b, c)
    inputs <- update_inputs_impl(old, new)
    expected <- make_inputs_impl(x, a = "a", b, c)
    expect_equal(inputs, expected)
  })
})

describe("remove_inputs_impl", {
  it("should be able to remove inputs", {
    old <- make_inputs_impl(x)
    inputs <- remove_inputs_impl(old, x)
    expected <- make_inputs_impl()
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x = 10)
    inputs <- remove_inputs_impl(old, x)
    expected <- make_inputs_impl()
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x, y)
    inputs <- remove_inputs_impl(old, x)
    expected <- make_inputs_impl(y)
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x, y)
    inputs <- remove_inputs_impl(old, x, y)
    expected <- make_inputs_impl()
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x, y)
    inputs <- remove_inputs_impl(old, y, x)
    expected <- make_inputs_impl()
    expect_equal(inputs, expected)
  })

  it("should not do anything if the input does not exist", {
    # TODO or should this throw an error?
    old <- make_inputs_impl()
    inputs <- remove_inputs_impl(old, x)
    expected <- old
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    inputs <- remove_inputs_impl(old, y)
    expected <- old
    expect_equal(inputs, expected)

    old <- make_inputs_impl(x)
    inputs <- remove_inputs_impl(old, x, y)
    expected <- make_inputs_impl()
    expect_equal(inputs, expected)
  })

  it("should ignore the same repeated inputs", {
    old <- make_inputs_impl(x)
    inputs <- remove_inputs_impl(old, x, x)
    expected <- make_inputs_impl()
    expect_equal(inputs, expected)
  })

  it("should not evaluate the inputs", {
    start <- Sys.time()
    old <- make_inputs_impl(x = Sys.sleep(10))
    inputs <- remove_inputs_impl(old, x)
    end <- Sys.time() - start
    expect_lt(end, 10)
  })

  it("should error if any inputs are not bare symbols", {
    old <- make_inputs_impl(x, y)
    expect_error({
      remove_inputs_impl(old, "x")
    })

    expect_error({
      remove_inputs_impl(old, 1)
    })

    expect_error({
      remove_inputs_impl(old, x, quote(y))
    })
  })
})
shunsambongi/planner documentation built on Aug. 19, 2022, 9:57 a.m.