From 6c6a94734bb25c7b9713b25f90d95dbbdf8cb186 Mon Sep 17 00:00:00 2001 From: Rich FitzJohn Date: Mon, 28 Oct 2024 07:27:51 +0000 Subject: [PATCH] Tidy up tests --- R/compile.R | 17 +---- R/util.R | 16 +++++ tests/testthat/test-compile.R | 124 ++++++++++++++-------------------- tests/testthat/test-util.R | 11 +++ 4 files changed, 80 insertions(+), 88 deletions(-) diff --git a/R/compile.R b/R/compile.R index 6a21632d..9555c47c 100644 --- a/R/compile.R +++ b/R/compile.R @@ -216,7 +216,7 @@ dust_template_data <- function(name, time_type = if (time_type == "mixed") "continuous" else time_type, has_compare = deparse1(has_compare), has_adjoint = deparse1(has_adjoint), - parameters = deparse_parameters_df(parameters), + parameters = deparse_df(parameters, 4), default_dt = deparse1(default_dt), package = paste0(name, mangle %||% ""), linking_to = linking_to, @@ -320,18 +320,3 @@ dust_debug <- function(debug, call = parent.frame()) { assert_scalar_logical(debug, call = call) } } - - -deparse_parameters_df <- function(df) { - if (is.null(df)) { - return("NULL") - } - values <- vcapply(df, function(x) { - str <- paste(vcapply(x, deparse), collapse = ", ") - if (length(x) == 1) str else sprintf("c(%s)", str) - }) - ret <- c("data.frame(", - sprintf(" %s = %s", names(df), values)) - suffix <- rep(c("\n", ",\n", ")"), c(1, ncol(df) - 1, 1)) - paste0(ret, suffix, collapse = "") -} diff --git a/R/util.R b/R/util.R index 5148dbe6..9793cf29 100644 --- a/R/util.R +++ b/R/util.R @@ -148,3 +148,19 @@ rank_description <- function(rank) { sprintf("%d-dimensional array", rank) } } + + +deparse_df <- function(df, indent) { + if (is.null(df)) { + return("NULL") + } + values <- vcapply(df, function(x) { + str <- paste(vcapply(x, deparse), collapse = ", ") + if (length(x) == 1) str else sprintf("c(%s)", str) + }) + indent <- strrep(" ", indent) + ret <- c("data.frame(", + sprintf("%s%s = %s", indent, names(df), values)) + suffix <- rep(c("\n", ",\n", ")"), c(1, ncol(df) - 1, 1)) + paste0(ret, suffix, collapse = "") +} diff --git a/tests/testthat/test-compile.R b/tests/testthat/test-compile.R index c63b0dd8..de4a9d0b 100644 --- a/tests/testthat/test-compile.R +++ b/tests/testthat/test-compile.R @@ -1,81 +1,61 @@ test_that("can construct template data", { expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 1), + dust_template_data("foo", "foo", "discrete", FALSE, FALSE, NULL, 1), list(name = "foo", class = "foo", time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, - compiler_options = "")) - expect_equal( - dust_template_data("foo", "bar", "discrete", FALSE, FALSE, 1, - mangle = "abc"), - list(name = "foo", class = "bar", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "fooabc", + has_compare = "FALSE", has_adjoint = "FALSE", parameters = "NULL", + default_dt = "1", package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, compiler_options = "")) - expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 1, - linking_to = "baz"), - list(name = "foo", class = "foo", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "foo", linking_to = "cpp11, dust2, monty, baz", - cpp_std = NULL, compiler_options = "")) - expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 1, - linking_to = c("x", "dust2", "y")), - list(name = "foo", class = "foo", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "foo", linking_to = "cpp11, dust2, monty, x, y", - cpp_std = NULL, compiler_options = "")) - expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 1, - compiler_options = "-Xf"), - list(name = "foo", class = "foo", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, - compiler_options = "-Xf")) - expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 1, - optimisation_level = "none",compiler_options = "-Xf"), - list(name = "foo", class = "foo", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, - compiler_options = "-Xf -O0")) - expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 1, - cpp_std = "c++14"), - list(name = "foo", class = "foo", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "1", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = "c++14", - compiler_options = "")) - expect_equal( - dust_template_data("foo", "foo", "discrete", FALSE, FALSE, 0.25), - list(name = "foo", class = "foo", - time_type_property = "discrete", time_type = "discrete", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "0.25", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, - compiler_options = "")) - expect_equal( - dust_template_data("foo", "foo", "continuous", FALSE, FALSE, NULL), - list(name = "foo", class = "foo", - time_type_property = "continuous", time_type = "continuous", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "NULL", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, - compiler_options = "")) - expect_equal( - dust_template_data("foo", "foo", "mixed", FALSE, FALSE, NULL), - list(name = "foo", class = "foo", - time_type_property = "mixed", time_type = "continuous", - has_compare = "FALSE", has_adjoint = "FALSE", default_dt = "NULL", - package = "foo", linking_to = "cpp11, dust2, monty", cpp_std = NULL, - compiler_options = "")) +}) + +test_that("can mangle a package name", { + res <- dust_template_data("foo", "bar", "discrete", FALSE, FALSE, NULL, 1, + mangle = "abc") + expect_equal(res$name, "foo") + expect_equal(res$class, "bar") + expect_equal(res$package, "fooabc") +}) + +test_that("can add linking to", { + res <- dust_template_data("foo", "foo", "discrete", FALSE, FALSE, NULL, 1, + linking_to = "baz") + expect_equal(res$linking_to, "cpp11, dust2, monty, baz") +}) + +test_that("can link to multiple packages and avoid relinking dust", { + res <- dust_template_data("foo", "foo", "discrete", FALSE, FALSE, NULL, 1, + linking_to = c("x", "dust2", "y")) + expect_equal(res$linking_to, "cpp11, dust2, monty, x, y") +}) + +test_that("can pass compiler options", { + res <- dust_template_data("foo", "foo", "discrete", FALSE, FALSE, NULL, 1, + optimisation_level = "none", + compiler_options = "-Xf") + expect_equal(res$compiler_options, "-Xf -O0") +}) + +test_that("can control the C++ standard", { + res <- dust_template_data("foo", "foo", "discrete", FALSE, FALSE, NULL, 1, + cpp_std = "c++14") + expect_equal(res$cpp_std, "c++14") +}) + +test_that("can set a default dt", { + res <- dust_template_data("foo", "foo", "discrete", FALSE, FALSE, NULL, 0.25) + expect_equal(res$default_dt, "0.25") + res <- dust_template_data("foo", "foo", "continuous", FALSE, FALSE, NULL, + NULL) + expect_equal(res$default_dt, "NULL") + res <- dust_template_data("foo", "foo", "mixed", FALSE, FALSE, NULL, NULL) + expect_equal(res$default_dt, "NULL") +}) + +test_that("can add parameter information", { + df <- data.frame(name = c("a", "b")) + res <- dust_template_data("foo", "foo", "discrete", FALSE, FALSE, df, 0.25) + expect_equal(res$parameters, deparse_df(df, 4)) }) diff --git a/tests/testthat/test-util.R b/tests/testthat/test-util.R index 46ff0911..b21fba43 100644 --- a/tests/testthat/test-util.R +++ b/tests/testthat/test-util.R @@ -80,3 +80,14 @@ test_that("fmod works", { expect_equal(fmod(10, 0.1), 0) expect_equal(fmod(10, 0.01), 0) }) + + +test_that("nicely deparse a df", { + expect_equal(deparse_df(NULL, 2), "NULL") + expect_equal(deparse_df(data.frame(a = 1), 2), + 'data.frame(\n a = 1)') + expect_equal(deparse_df(data.frame(a = 1, b = "2"), 2), + 'data.frame(\n a = 1,\n b = "2")') + expect_equal(deparse_df(data.frame(a = c(1, 2), b = c("3", "4")), 4), + 'data.frame(\n a = c(1, 2),\n b = c("3", "4"))') +})