tests/testthat/test-servicetests.R

In avantcredit/servicetests: R Service Tests (http://github.com/khalidharun/r-test-api-services)

context('servicetests')

fn1 <- function(x, y) { x + y }

# Helpers to be able to test callback functions
.test_env <- new.env()
incr_flag <- function(flag) { assign(flag, get_flag(flag) + 1, envir = .test_env) }
get_flag <- function(flag) {
  if (!exists(flag, envir = .test_env)) return(0)
  get(flag, envir = .test_env, inherits = FALSE)
}
test_flag <- function(flag) { exists(flag, envir = .test_env) }
reset_flags <- function() { rm(list = ls(.test_env, all = TRUE), envir = .test_env) }

fail_fn <- function(...) { incr_flag('failed') }
pass_fn <- function(...) { incr_flag('passed') }
pass_all_fn <- function() { incr_flag('passed_all') }
fail_any_fn <- function() { incr_flag('failed_any') }

context('registry')

describe('clear_registry', {
  it('empties registery', {
    # setup
    clear_registry()
    register_service_call("fn1 A", fn1(1,2))

    # exercise
    clear_registry()

    # verify
    reg <- get_registry()
    expect_true(identical(reg, list()))
  })
})

context('register_service_call')
describe('register_service_call', {

  it('is a function', {
    # exercise
    expect_true(is.function(register_service_call))
  })

  it ('fails if missing parameters', {
    # setup
    clear_registry()

    expect_error(register_service_call(), "No key provided.")
    expect_error(register_service_call("foo"), "No service call provided.")
  })

  test_that('it registers a service call', {
    # setup
    clear_registry()

    # exercise
    register_service_call("fn1", fn1(1, 2))

    # # verify
    reg <- servicetests:::get_registry()
    expect_true(exists('fn1', reg))
    obj <- reg[[1]]
    expect_true(exists('fname', obj))
    expect_true(exists('params', obj))
    expect_true(exists('expected', obj))

    expect_true(identical(obj$fname, 'fn1'))
    expect_true(identical(obj$params, list(1,2)))
    expect_true(identical(obj$expected, 3))
  })

  test_that('it registers service calls with a call as input', {
    # setup
    clear_registry()

    # exercise
    register_service_call("fn1", quote(fn1(1, 2)))

    # verify
    reg <- servicetests:::get_registry()
    expect_true(exists('fn1', reg))
    obj <- reg[[1]]
    expect_true(exists('fname', obj))
    expect_true(exists('params', obj))
    expect_true(exists('expected', obj))

    expect_true(identical(obj$fname, 'fn1'))
    expect_true(identical(obj$params, list(1,2)))
    expect_true(identical(obj$expected, 3))
  })

  test_that ("it registeres service calls with a quoted list as input", {
    # setup
    clear_registry()

    # exercise
    register_service_call("fn1", quote(list(call = fn1(1,2), match_fn = identical)))

    # verify
    reg <- servicetests:::get_registry()
    expect_true(exists('fn1', reg))

    obj <- reg[['fn1']]
    expected_names <- c('fname', 'params', 'expected', 'match_fn', 'key', 'hash')
    expect_true(all(expected_names %in% names(obj)))

    expect_true(identical(obj$fname, 'fn1'))
    expect_true(identical(obj$params, list(1,2)))
    expect_true(identical(obj$expected, 3))
    expect_true(identical(obj$match_fn, "identical"))
  })

  test_that('it detects service calls that collide', {
    # setup
    clear_registry()

    # exercise/verify
    register_service_call("fn1", fn1(1,2))
    warning_msg <-
    expect_warning(register_service_call("fn1", fn1(1,2)), "Service call is already registered.")
    expect_warning(register_service_call("fn1", fn1(3,2)), "Service call is already registered.")
  })

  test_that('it fails non-service call expressions', {
    # setup
    clear_registry()

    # TODO
    # expect_error(register_service_call(1+1), "Expression must begin with a function call")
  })
})


context('register_service_calls')
describe('given a list of service calls', {
  it ('registers the quoted list and from ...', {
    # setup
    clear_registry()
    call_list <- quote(list(
      "fn1 A" = fn1(1,2),
      "fn1 B" = fn1(3,4)
    ))

    # exercise
    register_service_calls(
      call_list = call_list,
      "fn1 C" = fn1(5,6),
      "fn1 D" = fn1(7,8),
      envir = environment()
    )

    # verify
    reg <- get_registry()
    expect_equal(4, length(reg))
    expect_equal(c('fn1 A', 'fn1 B', 'fn1 C', 'fn1 D'), names(reg))

    output_expected <- c(3, 7, 11, 15)
    lapply(seq_along(reg), function(i) {
      expect_equal(reg[[i]]$fname, "fn1")
      expect_equal(reg[[i]]$expected, output_expected[i])
    })
  })
})


context('test_service')

test_that('it is a function', {
  expect_true(is.function(test_service))
})

describe('when a service is registered', {
  # setup
  clear_registry()
  register_service_call("fn1 A", fn1(1,2))

  reg <- get_registry()
  obj <- reg[[1]]

  it('succeeeds when the service call returns the same value', {
    #exercise
    expect_true(test_service(obj))
  })

  it('fails when service call returns different values', {
    # setup
    fn1 <- function(x,y) {FALSE}

    # exercise/verify
    expect_false(test_service(obj))

    # teardown
    rm("fn1")
    expect_true(test_service(obj))
  })

  describe ("when given a custom matcher", {
    new_obj <- append(obj, list(match_fn = "identical"))

    it("succeeds when the service call returns the same value", {
      expect_true(test_service(new_obj))
    })

    it("fails when service call returns different values", {
      # setup
      fn1 <- function(x,y) {FALSE}

      # exercise/verify
      expect_false(test_service(new_obj))

      # teardown
      rm("fn1")
      expect_true(test_service(new_obj))
    })

    it("retains the actual value when the match_fn fails", {
      new_obj <- obj
      new_obj$match_fn <- function(...) stop("Error")
      env <- new.env()
      expect_false(test_service(new_obj, on.fail_each =
        function(obj, value) { env$value <- value }))
      expect_equal(env$value, 3)
    })
  })

  it('fails when service call has a runtime error', {
    fn1 <- function(x,y) { stop("beep beep. This is just a test.") }

    expect_false(test_service(obj))

    rm("fn1")
    expect_true(test_service(obj))
  })

  it('fails when passing a non-function arguments for on.fail, on.pass, on.pass_all', {
    #exercise/verify
    expect_error(test_service(obj, on.pass = "foo"))
    expect_error(test_service(obj, on.fail = "foo"))
    expect_error(test_service(obj, on.pass_all = "foo"))
  })

  it('runs pass callbacks correctly', {
    # setup for pass
    reset_flags()

    # exercise
    test_service(obj, on.pass_each = pass_fn, on.fail_each = fail_fn)

    # verify
    expect_true(test_flag("passed"))
    expect_equal(1, get_flag("passed"))
    expect_false(test_flag("failed"))
  })

  it ('runs fail callback correctly', {
    # setup
    fn1 <- function(x,y) {FALSE}
    reset_flags()

    # exercise
    test_service(obj, on.pass = pass_fn, on.fail = fail_fn)
    expect_true(test_flag('failed'))
    expect_equal(1, get_flag('failed'))
    expect_false(test_flag('passed'))
  })

  it ("returns stack trace in on.fail callback", {

    # setup
    fn1 <- function(...) stop("Force error.")

    stack_trace <- NULL
    examine_stacktrace <- function(obj, actual) {
      stack_trace <<- actual
    }

    # exercise
    test_service(obj, on.fail = examine_stacktrace)

    expect_true("calls" %in% names(stack_trace))
    expect_true(all(Reduce(c, lapply(stack_trace$calls, is.call))))

    rm("fn1")
    expect_true(test_service(obj))
  })
})

context('test_service_calls')

describe ('test_service_calls', {
  it('it is a function', {
    expect_true(is.function(test_service_calls))
  })

  it('it errors when passing a non-supported return type', {
    expect_error(test_service_calls(return.type = 'unknown'))
  })

  describe ("when two are regsitered", {

    setup_two_registered <- function() {
      clear_registry()
      register_service_call("fn1 A", fn1(1,2))
      register_service_call("fn1 B", fn1(3,4))
    }

    it('it processes each registered test', {
      setup_two_registered()

      # exercise
      output <- test_service_calls()

      # verify
      reg <- get_registry()
      output_expected <- setNames(list(TRUE, TRUE), names(reg))
      expect_true(identical(output, output_expected))
    })

    it('it fails when service call changes', {
      setup_two_registered()

      # exercise
      fn1 <- function(x,y) { FALSE }
      output <- test_service_calls()

      # verify
      reg <- get_registry()
      output_expected <- setNames(list(FALSE, FALSE), names(reg))
      expect_true(identical(output, output_expected))

      # teardown
      fn1 <- NULL
    })

    it ("can be forced to re-register a service call when response changes", {
      setup_two_registered()

      fn1 <- function(x,y) { FALSE }

      reg <- get_registry()
      output <- test_service_calls()
      output_expected <- setNames(list(FALSE, FALSE), names(reg))
      expect_equal(output, output_expected)

      register_service_call("fn1 A", fn1(1,2), envir = environment(), force = TRUE)

      reg <- get_registry()
      output <- test_service_calls()
      output_expected <- setNames(list(TRUE, FALSE), names(reg))
      expect_equal(output, output_expected)

      rm('fn1')
    })

    it ("can be forced to re-register a service call when the call changes", {
      setup_two_registered()

      reg <- get_registry()
      output <- test_service_calls()
      output_expected <- setNames(list(TRUE, TRUE), names(reg))
      expect_equal(output, output_expected)

      # exercise
      fn2 <- function(x,y) FALSE
      register_service_call("fn1 A", fn2(1,2), environment(), force = TRUE)
      reg <- get_registry()

      # verify that the proper services are registered
      expect_identical(setNames(list('fn2', 'fn1'), c('fn1 A', 'fn1 B')), lapply(reg, function(x) x$fname))

      # verify that the service tests pass
      output <- test_service_calls()
      output_expected <- setNames(list(TRUE, TRUE), names(reg))
      expect_equal(output, output_expected)

      # clean up
      rm('fn2')
    })

    it ('it returns a list when return.type = "verbose"', {
      setup_two_registered()

      # exercise
      output <- test_service_calls(return.type = "verbose")

      # verify
      expect_is(output, 'list')
    })

    it ('it returns a logical when return.type = "logical"', {
      setup_two_registered()

      # exercise
      output <- test_service_calls(return.type = "logical")

      # verify
      expect_is(output, 'logical')
    })

    it ('runs pass_all callback on pass', {
      # setup
      setup_two_registered()
      reset_flags()

      # verify
      output <- test_service_calls(on.pass_all = pass_all_fn)

      # verify
      expect_true(test_flag('passed_all'))
      expect_false(test_flag('passed'))
      expect_false(test_flag('failed'))
    })

    describe ('plus one more service test', {
      it ('runs callback on more complicated test results', {
        # setup: register fn2 then change fn2 response
        setup_two_registered()
        fn2 <- function(x,y) { x * y }
        register_service_call("fn2", fn2(3,4))
        reg <- get_registry()
        expect_equal(3, length(reg))

        fn2 <- function(...) { FALSE }
        reset_flags()

        # verify
        output <- test_service_calls(on.pass_all = pass_all_fn, on.fail_any = fail_any_fn, on.pass = pass_fn, on.fail = fail_fn)

        # verify
        expect_false(test_flag('passed_all'))
        expect_true(test_flag('failed_any'))
        expect_true(test_flag('passed'))
        expect_true(test_flag('failed'))
        expect_equal(1, get_flag('failed'))
        expect_equal(2, get_flag('passed'))
      })
    })
  })
})

context('cache registry')

describe ("cache registry", {
  default_cache_root <- normalizePath(getOption("servicetest.dir", "~/.R/servicetests"))

  it ('saves and loads registry from file', {
    # check to make sure cache file does not exist
    clear_registry()
    cache_file <- "test"
    cache_root <- servicetests:::get_cache_root()
    expect_identical(default_cache_root, cache_root)

    cache_path <- file.path(cache_root, cache_file)
    if (file.exists(cache_path)) file.remove(cache_path)
    expect_false(file.exists(cache_path))

    # add 1 servicetest
    register_service_call("fn1 A", fn1(1,2))
    expect_equal(1, length(get_registry()))

    # save regsitry to cache
    save_registry(cache_file)
    expect_true(file.exists(cache_path))

    # add more servicetests to current registry
    register_service_call("fn1 B", fn1(3,4))
    expect_equal(2, length(get_registry()))

    # load registry from file and see if it revert back to when it was saved
    load_registry(cache_file)
    expect_equal(1, length(get_registry()))

    # teardown
    file.remove(cache_path)
    expect_false(file.exists(cache_path))
  })

  it ('can set a cache_path', {
    # verify global cache is being used
    expect_identical(default_cache_root, servicetests:::get_cache_root())

    # setup cache in an empty path
    tmp_root <- file.path(tempdir(), 'testing')
    expect_false(file.exists(tmp_root))

    # exercise
    servicetests:::set_cache_root(tmp_root)

    # verify that path was created
    expect_identical(normalizePath(tmp_root), servicetests:::get_cache_root())
    expect_true(file.exists(tmp_root))

    # teardown - remove tmp files and restore cache_root to default
    file.remove(tmp_root)
    expect_false(file.exists(tmp_root))
    servicetests:::set_cache_root()
    expect_identical(default_cache_root, servicetests:::get_cache_root())
  })
})