tests/testthat/test-package.R

In mrc-ide/dust: Iterate Multiple Realisations of Stochastic Models

test_that("validate package", {
  skip_if_not_installed("pkgload")
  skip_on_cran()

  path <- create_test_package()
  ## ensure we create these as needed
  unlink(file.path(path, "R"), recursive = TRUE)
  unlink(file.path(path, "src"), recursive = TRUE)

  path <- dust_package(path, quiet = TRUE)
  expect_false(any(grepl("##'", readLines(file.path(path, "R", "dust.R")))))

  expect_true(file.exists(file.path(path, "src/Makevars")))
  expect_equal(
    readLines(file.path(path, "src/Makevars")),
    readLines(dust_file("template/Makevars.pkg")))

  pkgbuild::compile_dll(path, quiet = TRUE)
  res <- pkgload::load_all(path, quiet = TRUE)
  w <- res$env$walk$new(list(sd = 1), 0, 100)
  expect_equal(w$state(), matrix(0, 1, 100))

  expect_equal(w$run(0), matrix(0, 1, 100))
  w$update_state(state = pi)
  expect_equal(w$run(0), matrix(pi, 1, 100))
  w$set_index(integer(0))
  expect_equal(w$run(0), matrix(0, 0, 100))

  rm(w)
  gc()
})


test_that("validate package dependencies", {
  deps <- data.frame(
    type = c("LinkingTo", "LinkingTo"),
    package = c("cpp11", "dust"),
    version = "*",
    stringsAsFactors = FALSE)
  expect_silent(package_validate_has_dep(deps, "cpp11", "LinkingTo"))
  expect_error(
    package_validate_has_dep(deps, "cpp11", "Depends"),
    "Expected package 'cpp11' as 'Depends' in DESCRIPTION")
  expect_error(
    package_validate_has_dep(deps, "other", "Imports"),
    "Expected package 'other' as 'Imports' in DESCRIPTION")
})


test_that("validate destination notices existing C++ code", {
  msg <- "File '.+\\.cpp' does not look like it was created by dust - stopping"
  path <- create_test_package()

  path_cpp <- file.path(path, "src", "walk.cpp")
  file.create(path_cpp)

  expect_error(
    package_validate_destination(path, c("sir.cpp", "walk.cpp")),
    msg)

  writeLines("// some actual content", path_cpp)
  expect_error(
    package_validate_destination(path, c("sir.cpp", "walk.cpp")),
    msg)

  writeLines("// Generated by dust", path_cpp)
  expect_silent(
    package_validate_destination(path, c("sir.cpp", "walk.cpp")))
})


test_that("validate destination notices existing R code", {
  msg <- "File '.+\\.R' does not look like it was created by dust - stopping"
  path <- create_test_package()

  path_r <- file.path(path, "R", "dust.R")
  file.create(path_r)

  expect_error(
    package_validate_destination(path, character()),
    msg)

  writeLines("## some actual content", path_r)
  expect_error(
    package_validate_destination(path, character()),
    msg)

  writeLines("## Generated by dust", path_r)
  expect_silent(
    package_validate_destination(path, character()))
})


test_that("Fail to run if no dust files found", {
  path <- create_test_package()
  unlink(dir(file.path(path, "inst", "dust"), full.names = TRUE))
  expect_error(
    dust_package(path),
    "No dust files found in '.+/inst/dust'")
})


test_that("Fail to run if NAMESPACE missing", {
  path <- create_test_package()
  unlink(file.path(path, "NAMESPACE"))
  expect_error(
    package_validate(path),
    "Expected a file 'NAMESPACE' at path '.+'")
})


test_that("Fail to run if DESCRIPTION missing", {
  path <- create_test_package()
  unlink(file.path(path, "DESCRIPTION"))
  expect_error(
    package_validate(path),
    "Expected a file 'DESCRIPTION' at path '.+'")
})


test_that("Validate NAMESPACE has correct useDynLib call", {
  path <- create_test_package()
  path_ns <- file.path(path, "NAMESPACE")

  expect_null(package_validate_namespace(path_ns, "pkg"))
  expect_error(
    package_validate_namespace(path_ns, "other"),
    "Found a useDynLib call but not for 'other'")

  txt <- readLines(path_ns)
  writeLines(gsub('"', "", txt), path_ns)
  expect_null(package_validate_namespace(path_ns, "pkg"))
  expect_error(
    package_validate_namespace(path_ns, "other"),
    "Found a useDynLib call but not for 'other'")

  file.create(path_ns)
  expect_error(
    package_validate_namespace(path_ns, "other"),
    "Did not find a useDynLib call in NAMESPACE")
})


test_that("Validate NAMESPACE from dust_package", {
  path <- create_test_package()
  file.create(file.path(path, "NAMESPACE"))
  expect_error(
    dust_package(path),
    "Did not find a useDynLib call in NAMESPACE")
})


test_that("Validate openmp support", {
  text <- read_lines(dust_file("template/Makevars.pkg"))
  expect_silent(package_validate_makevars_openmp(text))
  msg <- "Package has a 'src/Makevars' but no openmp flags support"
  expect_error(
    package_validate_makevars_openmp(""),
    msg)
  expect_error(
    package_validate_makevars_openmp("PKG_CXXFLAGS=$(SHLIB_OPENMP_CXXFLAGS)"),
    msg)
  expect_error(
    package_validate_makevars_openmp("PKG_LIBS=$(SHLIB_OPENMP_CXXFLAGS)"),
    msg)
})


test_that("Validate openmp support in real package", {
  path <- create_test_package()
  file.create(file.path(path, "src/Makevars"))
  expect_error(
    dust_package(path),
    "Package has a 'src/Makevars' but no openmp flags support")
})


test_that("guide user to sensible package name", {
  path <- create_test_package()

  path_descr <- file.path(path, "DESCRIPTION")
  descr <- sub("Package: pkg", "Package: my.pkg", readLines(path_descr),
               fixed = TRUE)
  writeLines(descr, path_descr)

  path_namespace <- file.path(path, "NAMESPACE")
  namespace <- sub("pkg", "my.pkg", readLines(path_namespace),
               fixed = TRUE)
  writeLines(namespace, path_namespace)

  expect_error(
    dust_package(path),
    "Package name must not contain '.' or '_' (found 'my.pkg')",
    fixed = TRUE)
})


test_that("can create package with ode model", {
  path <- create_test_package(
    "pkgode", examples = c("ode/logistic.cpp", "ode/parallel.cpp"))
  path <- dust_package(path, quiet = TRUE)
  res <- pkgload::load_all(path, quiet = TRUE)
  cmp <- example_logistic()

  expect_s3_class(res$env$logistic, "dust_generator")
  expect_s3_class(res$env$parallel, "dust_generator")

  t <- seq(0, 51, by = 1)
  expect_equal(
    res$env$logistic$new(cmp$pars, 0, 1)$simulate(t),
    cmp$generator$new(cmp$pars, 0, 1)$simulate(t))
})