tests/testthat/test_Callback.R

In mlr3misc: Helper Functions for 'mlr3'

test_that("Callback works", {
  CallbackTest  = R6Class("CallbackTest",
    inherit = Callback,
    public = list(
      on_stage = function(callback, context) {
        context$a = 1
      },
      info = "Test"
    )
  )
  test_callback = CallbackTest$new(id = "mlr3misc.test", label = "Test Callback", man = "mlr3misc::Callback")

  expect_equal(test_callback$id, "mlr3misc.test")
  expect_equal(test_callback$label, "Test Callback")
  expect_equal(test_callback$info, "Test")
  expect_man_exists(test_callback$man)

  ContextTest = R6::R6Class("ContextTest", inherit = Context, public = list(a = NULL))
  context = ContextTest$new(id = "test")
  test_callback$call("on_stage", context)
  expect_equal(context$a, 1)
  expect_null(test_callback$call("on_stage_2", context))

  expect_list(test_callback$state)
  test_callback$state$b = 1
  expect_equal(test_callback$state$b, 1)
})

test_that("call_back() function works", {

  CallbackTest1 = R6Class("CallbackTest1",
    inherit = Callback,
    public = list(
      on_stage_1 = function(callback, context) {
        context$a = 1
      },
      on_stage_2 = function(callback, context) {
        context$b = 2
      }
    )
  )

  test_callback_1 = CallbackTest1$new(id = "mlr3misc.test", label = "Test Callback")

  CallbackTest2 = R6Class("CallbackTest1",
    inherit = Callback,
    public = list(
      on_stage_1 = function(callback, context) {
        context$c = 2
      }
    )
  )

  test_callback_2 = CallbackTest2$new(id = "mlr3misc.test", label = "Test Callback")

  CallbackTest3 = R6Class("CallbackTest1",
    inherit = Callback,
    public = list(
      on_stage_3 = function(callback, context) {
        context$d = 1
      }
    )
  )

  test_callback_3 = CallbackTest3$new(id = "mlr3misc.test", label = "Test Callback")

  callbacks = list(test_callback_1, test_callback_2, test_callback_3)
  ContextTest = R6::R6Class("ContextTest", inherit = Context, public = list(a = NULL, b = NULL, c = NULL, d = NULL))
  context = ContextTest$new(id = "test")
  call_back("on_stage_1", callbacks, context)

  expect_equal(context$a, 1)
  expect_null(context$b)
  expect_equal(context$c, 2)
  expect_null(context$d)

  call_back("on_stage_2", callbacks, context)

  expect_equal(context$a, 1)
  expect_equal(context$b, 2)
  expect_equal(context$c, 2)
  expect_null(context$d)

  call_back("on_stage_3", callbacks, context)

  expect_equal(context$a, 1)
  expect_equal(context$b, 2)
  expect_equal(context$c, 2)
  expect_equal(context$d, 1)
})



test_that("as_callbacks.Callback works", {
  CallbackTest  = R6Class("CallbackTest",
    inherit = Callback,
    public = list(
      on_stage = function(callback, context) {
        context$a = 1
      },
      info = "Test"
    )
  )
  test_callback = CallbackTest$new(id = "mlr3misc.test", label = "Test Callback", man = "mlr3misc::Callback")

  expect_list(as_callbacks(test_callback))
})