context("Insertions") insrt <- Insertion(anchor = 6, name = "Low", `function` = "subtotal", args = c(1, 2)) insrts <- Insertions(data = list( list( anchor = 6, name = "Low", `function` = "subtotal", args = c(1, 2) ), list( anchor = 7, name = "High", `function` = "subtotal", args = c(9, 10) ) )) test_that("Insertion and insertion inheritence, base methods", { expect_equal(anchor(insrt), 6) expect_equal(name(insrt), "Low") expect_equal(arguments(insrt), c(1, 2)) expect_equal(anchors(insrts), c(6, 7)) expect_equal(funcs(insrts), c("subtotal", "subtotal")) }) insrt2 <- insrt test_that("Insertion setters", { anchor(insrt2) <- 1 expect_equal(anchor(insrt2), 1) name(insrt2) <- "Low low" expect_equal(name(insrt2), "Low low") subtotals(insrt2) <- c(10, 20) expect_equal(arguments(insrt2), c(10, 20)) arguments(insrt2) <- c(100, 200) expect_equal(arguments(insrt2), c(100, 200)) }) test_that("Insertion can take an anchor of int, top, or bottom", { anchor(insrt2) <- "top" expect_equal(anchor(insrt2), "top") anchor(insrt2) <- "bottom" expect_equal(anchor(insrt2), "bottom") anchor(insrt2) <- 4 expect_equal(anchor(insrt2), 4) }) test_that("Anchors can be converted from subtotal/header to insertion", { sub <- Subtotal(name = "name", categories = c(1, 2), after = 1) sub_top <- Subtotal(name = "name", categories = c(1, 2), position = "top") sub_bottom <- Subtotal(name = "name", categories = c(1, 2), position = "bottom") # TODO: check category names with a categories object expect_equal(anchor(sub), 1) expect_equal(anchor(sub_top), "top") expect_equal(anchor(sub_bottom), "bottom") }) test_that("Insertion setter validation", { expect_error( anchor(insrt2) <- "one", paste0( "an anchor must be a numeric or the character ", dQuote("top"), " or ", dQuote("bottom") ) ) expect_error(name(insrt2) <- 2, 'Names must be of class "character"') expect_error(subtotals(insrt2) <- "3, 4", "a subtotal must be a numeric") }) test_that("Insertion validation", { expect_error( Insertion(anchor = 0), "invalid class .*Insertion.* object:.* Missing: .*name*" ) expect_error( Insertion(name = "bar"), "invalid class .*Insertion.* object:.* Missing: .*anchor*" ) expect_error( Insertion(anchor = 0, name = "bar", `function` = "baz"), "If an Insertion has a .*function.* it must also have .*args.*" ) }) test_that("Insertion and insertions show methods", { expect_prints( insrt, get_output(data.frame( anchor = c(6), name = c("Low"), func = c("subtotal"), args = c("1 and 2") )) ) expect_prints( insrts, get_output(data.frame( anchor = c(6, 7), name = c("Low", "High"), func = c("subtotal", "subtotal"), args = c("1 and 2", "9 and 10") )) ) }) test_that("Insertion and insertions show methods with hetrogeneous insertions", { insrts <- Insertions( Subtotal( name = "Cats A+B", after = "B", categories = c("A", "B") ), Heading(name = "The end", after = "D") ) expect_prints(insrts, get_output(data.frame( anchor = c("B", "D"), name = c("Cats A+B", "The end"), func = c("subtotal", NA), # NA is a string because we serialPaste them args = c("A and B", "NA"), kwargs = c("", "") )), fixed = TRUE ) }) test_that("Insertion and insertions show methods with subdiffs", { insrts <- Insertions( Subtotal( name = "A+B-D", after = "B", categories = c("A", "B"), negative = "D" ), Subtotal( name = "-C", after = "C", negative = "C" ) ) expect_prints(insrts, get_output(data.frame( anchor = c("B", "C"), name = c("A+B-D", "-C"), func = c("subtotal", "subtotal"), # NA is a string because we serialPaste them args = c("A and B", ""), kwargs = c("negative: D", "negative: C") )), fixed = TRUE ) }) test_that("args returns NA when not found", { expect_equal(arguments(Insertion(anchor = "foo", name = "bar")), NA) }) # Test to get coverage of edge cases with_mock_crunch({ ds <- cachedLoadDataset("test ds") categories <- categories(ds$location) subvars <- subvariables(ds$mymrset) test_that("can get negative terms from names", { subtotal <- Subtotal("nps", "London", negative = "Scotland") expect_equal( categoricalSubtotalTerms(subtotal, categories), list(positive = 1, negative = 2) ) }) test_that("can get default position from subvariable names", { subtotal <- Subtotal("top2", c("Second", "First")) expect_equal( .convertAnchor(subtotal, subvars), list(position = "after", alias = "subvar1") ) }) test_that("get error when mr anchor doesn't match", { subtotal <- Subtotal("top2", c("Second", "First"), after = "BLAH") expect_error( .convertAnchor(subtotal, subvars), "Could not find anchor `BLAH` in subvariable aliases or names." ) }) })