Skip to content

Commit

Permalink
Tidy up tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@richfitz
richfitz committed Oct 28, 2024
1 parent c8a2a56 commit 6c6a947
Show file tree
Hide file tree
Showing 4 changed files with 80 additions and 88 deletions.
17 changes: 1 addition & 16 deletions R/compile.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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 = "")
}
16 changes: 16 additions & 0 deletions R/util.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 = "")
}
124 changes: 52 additions & 72 deletions tests/testthat/test-compile.R
View file
Original file line number Diff line number Diff line change
@@ -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))
})


Expand Down
11 changes: 11 additions & 0 deletions tests/testthat/test-util.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"))')
})

0 comments on commit 6c6a947

Please sign in to comment.