tests/testthat/helper.R

In bit64: A S3 Class for Vectors of 64bit Integers

matrix64 = function(x, nrow=1L, ncol=1L, byrow=FALSE, dimnames=NULL) {
  matrix(as.integer64(x), nrow=nrow, ncol=ncol, byrow=byrow, dimnames=dimnames)
}

array64 = function(x, dim) {
  array(as.integer64(x), dim=dim)
}

# Test that 'expr' gives the same result whether
#   the input is integer or integer64, in the sense
#   of equivalence after casting between the types.
# expr gets integer names converted to integer64,
#   retaining attributes (esp. for arrays), and
#   we test that the result of evaluating expr
#   is equivalent (after converting back to integer)
# Starting with integer and casting to integer64
#   guarantees representation, where casting integer64
#   to integer might have to stipulate inputs must be
#   representable as integer.
expect_int_32_64_equivalent = function(expr) {
  # Capture the unevaluated expression
  esub = substitute(expr)
  evar = all.vars(esub)

  # replace all integer values in expr with integer64 equivalents
  #   in a tailored environment
  parent_ = parent.frame()
  int64_env = new.env(parent = parent_)
  for (key in evar) {
    val = get(key, parent_)
    if (!is.integer(val)) next
    assign(key, as.integer64(val), envir=int64_env)
    attributes(int64_env[[key]]) = attributes(val)
  }

  int_result = eval(expr, parent_)
  int64_result = eval(expr, int64_env)
  int64_result_as_int = methods::as(int64_result, typeof(int_result))
  # ignore class (which includes integer64)
  a64 = attributes(int64_result)
  for (a in setdiff(names(a64), "class"))
    attr(int64_result_as_int, a) = a64[[a]]

  expect_identical(int64_result_as_int, int_result)
}

expect_same_error = function(expr1, expr2) {
  err1 = tryCatch(expr1, error=identity)
  if (!inherits(err1, "error")) return(fail("'expr1' did not produce an error"))

  err2 = tryCatch(expr2, error=identity)
  if (!inherits(err2, "error")) return(fail("'expr2' did not produce an error"))

  msg1 = conditionMessage(err1)
  msg2 = conditionMessage(err2)

  if (msg1 == msg2) return(pass())
  fail(sprintf("Error messages differ.\n'expr1' failed as %s\n'expr2' failed as %s", msg1, msg2))
}