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], '')
+ expect_equal(ths[3], '')
+})
+
+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))
+})
|