tests/testthat/test-plan.R

In shunsambongi/planner: Plan out code execution

describe("plan", {
  it("should not have any warnings", {
    expect_failure(expect_warning({
      plan()
    }))
  })

  it("should not have any errors", {
    expect_failure(expect_error({
      plan()
    }))
  })
})

describe("is_plan", {
  it("should return TRUE for plans created by planner::plan", {
    expect_true(is_plan(plan()))
  })

  it("should return FALSE if the structure is not correct", {
    fake_plan <- structure(character(), class = "planner_plan")
    expect_false(is_plan(fake_plan))
  })

  it("should return FALSE if it doesn't have inputs and steps", {
    fake_plan <- structure(list(), class = "planner_plan")
    expect_false(is_plan(fake_plan))
  })
})

describe("add_inputs", {
  expect_inputs <- function(plan, inputs) {
    expect_equal(plan$inputs, inputs)
  }

  it("should update the plans inputs", {
    old <- plan()
    new <- add_inputs(old, x)
    expect_inputs(new, make_inputs_impl(x))

    old <- plan()
    new <- add_inputs(old, x, y)
    expect_inputs(new, make_inputs_impl(x, y))

    old <- plan(x)
    new <- add_inputs(old, y)
    expect_inputs(new, make_inputs_impl(x, y))
  })

  it("should allow default values to be added or removed", {
    old <- plan()
    new <- add_inputs(old, x = 10)
    expect_inputs(new, make_inputs_impl(x = 10))
  })

  it("should error if inputs already exist", {
    expect_error({
      add_inputs(plan(x = 10), x)
    }, regexp = "Inputs already exist: `x`")

    expect_error({
      add_inputs(plan(x = 10, y), x, y = 10)
    }, regexp = "Inputs already exist: `x`, `y`")
  })

  it("should allow expressions as default values", {
    old <- plan()
    new <- add_inputs(old, x = 1:3)
    expect_inputs(new, make_inputs_impl(x = 1:3))

    old <- plan(x)
    new <- add_inputs(old, y = x + 1)
    expect_inputs(new, make_inputs_impl(x, y = x + 1))

    old <- plan()
    new <- add_inputs(old, x = print("hello"))
    expect_inputs(new, make_inputs_impl(x = print("hello")))
  })
})

describe("extract_inputs", {
  it("should return just the inputs", {
    inputs <- extract_plan_inputs(plan(x))
    expected <- make_inputs_impl(x)
    expect_equal(inputs, expected)

    inputs <- extract_plan_inputs(plan(x, y))
    expected <- make_inputs_impl(x, y)
    expect_equal(inputs, expected)

    inputs <- extract_plan_inputs(plan(x, y = 10, z))
    expected <- make_inputs_impl(x, y = 10, z)
    expect_equal(inputs, expected)
  })
})

describe("remove_inputs", {
  it("should remove specified inputs from the plan", {
    old <- plan(x)
    new <- remove_inputs(old, x)
    expected <- plan()
    expect_equal(new, expected)

    old <- plan(x, y)
    new <- remove_inputs(old, x)
    expected <- plan(y)
    expect_equal(new, expected)

    old <- plan(x, y)
    new <- remove_inputs(old, x, y)
    expected <- plan()
    expect_equal(new, expected)
  })

  # TODO: remove these tests?
  # these cases are basically covered by remove_inputs_impl
  it("should error if inputs are not all symbols", {
    expect_error({
      remove_inputs(plan(), "x")
    })

    expect_error({
      remove_inputs(plan(), 10L)
    })

    expect_error({
      remove_inputs(plan(), 10.0)
    })

    expect_error({
      remove_inputs(plan(), TRUE)
    })
  })
})

describe("update_inputs", {
  it("should allow adding default values", {
    old <- plan(x)
    new <- update_inputs(old, x = 10)
    expected <- plan(x = 10)
    expect_equal(new, expected)

    old <- plan(x, y)
    new <- update_inputs(old, x = 10)
    expected <- plan(x = 10, y)
    expect_equal(new, expected)

    old <- plan(x, y = 20)
    new <- update_inputs(old, x = 10)
    expected <- plan(x = 10, y = 20)
    expect_equal(new, expected)
  })

  it("should allow removing default values", {
    old <- plan(x = 10)
    new <- update_inputs(old, x)
    expected <- plan(x)
    expect_equal(new, expected)

    old <- plan(x = 10, y)
    new <- update_inputs(old, x)
    expected <- plan(x, y)
    expect_equal(new, expected)

    old <- plan(x = 10, y = 20)
    new <- update_inputs(old, y)
    expected <- plan(x = 10, y)
    expect_equal(new, expected)
  })

  it("should allow NULL default values", {
    old <- plan(x)
    new <- update_inputs(old, x = NULL)
    expected <- plan(x = NULL)
    expect_equal(new, expected)
    expect_equal(extract_plan_inputs(new), list(x = NULL))
  })

  it("should error for names that don't exist", {
    expect_error({
      update_inputs(plan(), x)
    })

    expect_error({
      update_inputs(plan(x), y)
    })

    expect_error({
      update_inputs(plan(x), y)
    })
  })
})

describe("add_steps", {
  it("should error for existing steps", {
    old <- plan() %>%
      add_steps(x = function() {})
    expect_error({
      add_steps(old, x = function() {})
    }, regexp = "Steps already exist")
  })
})

describe("wrap_steps", {
  it("should return a plan", {
    old <- add_steps(plan(), x = function() 1)
    new <- wrap_steps(old, x = function(step) {
      function() {
        step() + 9000
      }
    })
    expect_true(is_plan(new))
    expect_s3_class(new, "planner_plan")
  })

  it("should return a wrapped version of the step", {
    old <- add_steps(plan(), x = function() 1)
    new <- wrap_steps(old, x = function(step) {
      function() {
        step() + 9000
      }
    })
    expect_equal(execute(new), 9001)
  })

  it("should error if there are unnamed wrappers", {
    old <- add_steps(plan(), x = function() {})
    expect_error({
      wrap_steps(old, function() {})
    })
  })

  it("should error if there are unknown wrappers", {
    old <- add_steps(plan(), x = function() {})
    expect_error({
      wrap_steps(old, y = function() {})
    }, "Unknown steps")
  })
})