test-util.R
In odin: ODE Generation and Integration

context("utilities")

test_that("read_user_c - simple", {
  ans <- read_user_c("user_fns.c")
  expect_equal(names(ans$declarations), "squarepulse")
  expect_equal(names(ans$definitions), "squarepulse")
})

test_that("read_user_c - split declaration", {
  ans <- read_user_c("user_fns2.c")
  expect_equal(names(ans$declarations), "squarepulse")
  expect_equal(names(ans$definitions), "squarepulse")
  expect_match(ans$declarations, "double t1\\);$")
})

test_that("read_user_c - parse error", {
  expect_error(read_user_c("user_fns3.c"),
               "Parse error for user_fns3.c", fixed = TRUE)
})


test_that("odin_version", {
  expect_true(setequal(names(odin_version()),
                       c("odin", "cinterpolate", "r", "platform")))
})


test_that("match_value", {
  object <- "foo"
  expect_error(match_value(object, letters), "object must be one of {a, ",
               fixed = TRUE)
  expect_silent(match_value("a", letters))
})


test_that("adrop works", {
  x <- 1:10
  m <- array(x, c(1, 10, 1))
  expect_equal(adrop(m, 1), cbind(x, deparse.level = 0))
  expect_error(adrop(m, 2), "Can't drop selected dimensions")
  expect_equal(adrop(m, 3), rbind(x, deparse.level = 0))

  expect_equal(adrop(array(x, c(1, 2, 5)), 1),
               matrix(x, 2, 5))
  expect_equal(adrop(array(x, c(2, 1, 5)), 2),
               matrix(x, 2, 5))
  expect_equal(adrop(array(x, c(2, 5, 1)), 3),
               matrix(x, 2, 5))
})


test_that("sprintf_safe throws on empty arguments", {
  expect_error(sprintf_safe("%s", NULL),
               "Passed empty format parameter to formatter")
  expect_error(sprintf_safe("%s %s", 1, NULL),
               "Passed empty format parameter to formatter")
  expect_error(sprintf_safe("%s %s", NULL, 1),
               "Passed empty format parameter to formatter")
  expect_equal(sprintf_safe("%s %s", "a", "b"),
               sprintf("%s %s", "a", "b"))
})


test_that("onload can be rerun safely", {
  expect_silent(.onLoad())
})


test_that("collector works", {
  obj <- collector()
  expect_equal(obj$get(), character(0))
  expect_equal(obj$length(), 0L)
  obj$add("a")
  expect_equal(obj$get(), "a")
  expect_equal(obj$length(), 1L)
  obj$add(c("b", "c"))
  expect_equal(obj$get(), c("a", "b", "c"))
  expect_equal(obj$length(), 3L)
})


test_that("collector_list works", {
  obj <- collector_list()
  expect_equal(obj$get(), list())
  obj$add("a")
  expect_equal(obj$get(), list("a"))
  obj$add(c("b", "c"))
  expect_equal(obj$get(), list("a", c("b", "c")))
})


test_that("counter works", {
  obj <- counter()
  expect_equal(obj$get(), 0L)
  obj$add()
  expect_equal(obj$get(), 1L)
  obj$add()
  expect_equal(obj$get(), 2L)
  obj$reset()
  expect_equal(obj$get(), 0L)
})


test_that("Can avoid debug in compile_dll", {
  skip_if_not_installed("mockery")
  skip_on_cran()

  mock_has_user_makevars <- mockery::mock(FALSE)
  mock_compile_dll <- mockery::mock(
    list(Sys.getenv("R_MAKEVARS_USER"), pkgbuild:::makevars_user()))

  path <- tempfile()
  compile_attributes <- TRUE
  quiet <- FALSE
  res <- with_mock(
    "odin::has_user_makevars" = mock_has_user_makevars,
    "pkgbuild::compile_dll" = mock_compile_dll,
    compile_dll(path, compile_attributes, quiet))

  expect_equal(res[[1]], res[[2]])
  expect_equal(normalizePath(dirname(res[[1]])),
               normalizePath(tempdir()))

  mockery::expect_called(mock_has_user_makevars, 1)
  mockery::expect_called(mock_compile_dll, 1)
  expect_equal(
    mockery::mock_args(mock_compile_dll)[[1]],
    list(path, compile_attributes, quiet))
})


test_that("Don't set envvar if not needed", {
  skip_if_not_installed("mockery")

  env <- c("R_MAKEVARS_USER" = NA)
  cmp <- withr::with_envvar(
    env,
    pkgbuild:::makevars_user())

  mock_has_user_makevars <- mockery::mock(TRUE)
  mock_compile_dll <- mockery::mock(
    list(Sys.getenv("R_MAKEVARS_USER"), pkgbuild:::makevars_user()))

  path <- tempfile()
  compile_attributes <- TRUE
  quiet <- FALSE

  res <- withr::with_envvar(
    env,
    with_mock(
      "odin::has_user_makevars" = mock_has_user_makevars,
      "pkgbuild::compile_dll" = mock_compile_dll,
      compile_dll(path, compile_attributes, quiet)))

  expect_equal(res[[1]], "")
  expect_equal(res[[2]], cmp)

  mockery::expect_called(mock_has_user_makevars, 1)
  mockery::expect_called(mock_compile_dll, 1)
  expect_equal(
    mockery::mock_args(mock_compile_dll)[[1]],
    list(path, compile_attributes, quiet))
})


test_that("validate inputs", {
  expect_silent(assert_scalar_logical_or_null(NULL))
  expect_silent(assert_scalar_logical_or_null(TRUE))
  expect_silent(assert_scalar_logical_or_null(FALSE))

  thing <- "true"
  expect_error(
    assert_scalar_logical_or_null(thing),
    "Expected 'thing' to be a logical scalar (or NULL)",
    fixed = TRUE)
  expect_error(assert_scalar_logical_or_null(NA),
               "Expected '.+' to be a logical scalar \\(or NULL\\)")
  expect_error(assert_scalar_logical_or_null(logical(0)),
               "Expected '.+' to be a logical scalar \\(or NULL\\)")
})


test_that("validate inputs", {
  expect_silent(assert_scalar_character_or_null(NULL))
  expect_silent(assert_scalar_character_or_null("a"))

  thing <- TRUE
  expect_error(
    assert_scalar_character_or_null(thing),
    "Expected 'thing' to be a character scalar (or NULL)",
    fixed = TRUE)
  expect_error(assert_scalar_character_or_null(NA),
               "Expected '.+' to be a character scalar \\(or NULL\\)")
  expect_error(assert_scalar_character_or_null(character(0)),
               "Expected '.+' to be a character scalar \\(or NULL\\)")
})


test_that("check names", {
  expect_error(
    assert_named(list()),
    "must be named")
  expect_error(
    assert_named(list(1, 2)),
    "must be named")
  expect_silent(
    assert_named(list(a = 1, a = 2)))
  expect_error(
    assert_named(list(a = 1, a = 2), TRUE),
    "must have unique names")
})


test_that("Check S3 class", {
  expect_silent(assert_is(structure(1, class = "foo"), "foo"))
  expect_error(assert_is(structure(1, class = "bar"), "foo"),
               "must be a foo")
  expect_error(assert_is(1, c("foo", "bar")),
               "must be a foo / bar")
})