diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R index 9151e1c..2ea6b69 100644 --- a/tests/testthat/test-createcustomtable.R +++ b/tests/testthat/test-createcustomtable.R @@ -157,3 +157,121 @@ test_that("circle.size drives the emitted circle geometry", expect_false(grepl("line-height:35px", h, fixed = TRUE)) expect_false(grepl("border-radius:35px", h, fixed = TRUE)) }) + +# spacer.col -------------------------------------------------------------- + +test_that("Default emits no spacer class", +{ + res <- CreateCustomTable(x2) + expect_false(grepl('class="spacer"', tableHtml(res), fixed = TRUE)) +}) + +test_that("A single spacer.col index produces exactly one spacer header cell", +{ + m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z"))) + res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2) + h <- tableHtml(res) + expect_equal(countOccurrences('', h), 1) + # the trailing space before the closing quote is load-bearing: col.header.styles is + # pasted with the (default empty-string) col.header.classes argument, so the three + # non-spacer headers carry "colheaderdefault1 " rather than "colheaderdefault1" + expect_equal(countOccurrences('class="colheaderdefault1 "', h), 3) +}) + +test_that("The spacer cell replaces, not augments, the default class", +{ + m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z"))) + res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2) + h <- tableHtml(res) + th <- regmatches(h, regexpr('X', h)) + expect_equal(th, 'X') +}) + +test_that("Multiple spacer.col indices produce spacer cells at those emission positions", +{ + m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z"))) + res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = c(2, 4)) + h <- tableHtml(res) + ths <- regmatches(h, gregexpr('[^<]*', h))[[1]] + expect_equal(length(ths), 4) + expect_equal(ths[2], 'X') + expect_equal(ths[4], 'Z') + expect_equal(ths[1], 'W') + expect_equal(ths[3], 'Y') +}) + +test_that("The spacer cell keeps its column label", +{ + m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z"))) + # spacer.col = 3 (not the sibling blocks' 2) is required here: with columns + # W, X, Y, Z, index 3 is the one that lands on "Y", which is the label this + # test needs to demonstrate survives being turned into a spacer cell + res <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 3) + h <- tableHtml(res) + expect_true(grepl('Y', h, fixed = TRUE)) +}) + +test_that("The corner cell shifts the spacer.col index when show.row.headers is TRUE", +{ + m4 <- matrix(1:12, 3, 4, dimnames = list(c("a", "b", "c"), c("W", "X", "Y", "Z"))) + res <- CreateCustomTable(m4, show.row.headers = TRUE, spacer.col = 2) + h <- tableHtml(res) + ths <- regmatches(h, gregexpr('[^<]*', h))[[1]] + expect_equal(length(ths), 5) + # the corner cell occupies emission position 1, so index 2 lands on the first + # data column ("W") rather than on the corner - pinning the index-shift contract + expect_equal(ths[1], '') + expect_equal(ths[2], 'W') +}) + +test_that("col.header.fill reaches the colheaderdefault CSS rule", +{ + res <- CreateCustomTable(x2, col.header.fill = "rgb(1,2,3)") + h <- normWs(tableHtml(res)) + expect_true(grepl('.colheaderdefault1{ background: rgb(1,2,3);', h, fixed = TRUE)) +}) + +test_that("col.header.fill defaults to transparent", +{ + res <- CreateCustomTable(x2) + h <- normWs(tableHtml(res)) + expect_true(grepl('.colheaderdefault1{ background: transparent;', h, fixed = TRUE)) +}) + +test_that("show.col.headers = FALSE suppresses the whole header row and its CSS", +{ + res <- CreateCustomTable(x2, show.col.headers = FALSE) + h <- tableHtml(res) + # ' rather than erroring or being + # a no-op. spacer.col = 6 is chosen (a multiple of the 3-column header vector) so the + # sprintf recycling itself does not error - this pins the actual defect, not a crash. + x2local <- matrix(1:12, 4, 3, dimnames = list(letters[1:4], c("X", "Y", "Z"))) + res <- CreateCustomTable(x2local, show.row.headers = FALSE, spacer.col = 6) + h <- tableHtml(res) + expect_equal(countOccurrences('class="NA"', h), 2) + expect_true(grepl('Z', h, fixed = TRUE)) + expect_equal(countOccurrences("', h, fixed = TRUE)) + expect_false(grepl('.spacer {', h, fixed = TRUE)) + + # confirm the negative assertion actually flips: with the default use.predefined.css = TRUE + # the same call does emit the ".spacer {" rule + resDefault <- CreateCustomTable(m4, show.row.headers = FALSE, spacer.col = 2) + expect_true(grepl('.spacer {', tableHtml(resDefault), fixed = TRUE)) +})