diff --git a/tests/testthat/test-createcustomtable.R b/tests/testthat/test-createcustomtable.R
index d983744..07345e6 100644
--- a/tests/testthat/test-createcustomtable.R
+++ b/tests/testthat/test-createcustomtable.R
@@ -926,3 +926,186 @@ test_that("sig.change.fills inline style is emitted only on the flagged body cel
expect_length(headerBlock, 1)
expect_false(grepl("style=", headerBlock, fixed = TRUE))
})
+
+# col.widths and custom.css ------------------------------------------------
+
+test_that("A single col.widths value emits exactly one
tag",
+{
+ res <- CreateCustomTable(x2, col.widths = '200px')
+ h <- normWs(tableHtml(res))
+ expect_equal(countOccurrences("", h, fixed = TRUE))
+})
+
+test_that("A comma-separated col.widths string is split into one tag per width, in order",
+{
+ res <- CreateCustomTable(x2, col.widths = "20%, 30%, 50%")
+ h <- normWs(tableHtml(res))
+ tags <- regmatches(h, gregexpr("]*>", h))[[1]]
+ expect_equal(tags, c("", "", ""))
+})
+
+test_that("A character vector col.widths is accepted equivalently to the comma-separated string",
+{
+ resString <- CreateCustomTable(x2, col.widths = "20%, 30%, 50%")
+ resVector <- CreateCustomTable(x2, col.widths = c("20%", "30%", "50%"))
+ hString <- normWs(tableHtml(resString))
+ tagsString <- regmatches(hString, gregexpr("]*>", hString))[[1]]
+ tagsVector <- regmatches(normWs(tableHtml(resVector)), gregexpr("]*>", normWs(tableHtml(resVector))))[[1]]
+ expect_equal(tagsVector, c("", "", ""))
+ expect_equal(tagsString, tagsVector)
+})
+
+test_that("The col.widths default is the row-header column's 25% width when rownames are present, and nothing when they are not",
+{
+ resWithRownames <- CreateCustomTable(x2)
+ hWith <- normWs(tableHtml(resWithRownames))
+ tags <- regmatches(hWith, gregexpr("]*>", hWith))[[1]]
+ expect_equal(tags, "")
+
+ x2NoRownames <- x2
+ rownames(x2NoRownames) <- NULL
+ resNoRownames <- CreateCustomTable(x2NoRownames)
+ expect_false(grepl("]*>", h))
+ expect_length(table, 1)
+ expect_true(grepl("width:calc(100% - 5px)", table, fixed = TRUE))
+})
+
+test_that("col.widths.fill.container = FALSE omits the calc() table width",
+{
+ # only col.widths.fill.container differs from the TRUE case above
+ res <- CreateCustomTable(x2, cell.border.width = 5, col.widths.fill.container = FALSE)
+ h <- normWs(tableHtml(res))
+ table <- regmatches(h, regexpr("]*>", h))
+ expect_length(table, 1)
+ expect_false(grepl("width:calc(100% - 5px)", table, fixed = TRUE))
+ # positive control: the height-side calc() (which is not gated by this argument)
+ # remains, so the negative assertion above isn't vacuously true from mangled output
+ expect_true(grepl("height:calc(100% - 5px)", table, fixed = TRUE))
+})
+
+test_that("The existing smoke-tested col.widths call also emits its tag",
+{
+ expect_error(res <- CreateCustomTable(x2, col.widths = '200px',
+ col.header.border.width = NULL, border.color = "red"), NA)
+ h <- normWs(tableHtml(res))
+ expect_true(grepl("", h, fixed = TRUE))
+})
+
+test_that("Fewer col.widths entries than columns emits only the supplied tags, unpadded",
+{
+ # 2 widths for a 4-column render (row header + 3 data columns): confirmed current
+ # behaviour is no padding/redistribution of the remaining columns
+ res <- CreateCustomTable(x2, col.widths = c("20%", "30%"))
+ h <- normWs(tableHtml(res))
+ tags <- regmatches(h, gregexpr("]*>", h))[[1]]
+ expect_equal(tags, c("", ""))
+})
+
+test_that("More col.widths entries than columns emits every supplied tag, untruncated",
+{
+ # x4 (with rownames) renders 5 columns (row header + W/X/Y/Z), so 7 widths is
+ # genuinely more than the column count, exercising the surplus path
+ x4 <- matrix(1:16, 4, 4, dimnames = list(letters[1:4], c("W", "X", "Y", "Z")))
+ res <- CreateCustomTable(x4, col.widths = c("20%", "30%", "10%", "10%", "5%", "1%", "2%"))
+ h <- normWs(tableHtml(res))
+ tags <- regmatches(h, gregexpr("]*>", h))[[1]]
+ expect_equal(tags, c("", "", "",
+ "", "", "", ""))
+})
+
+test_that("Custom CSS text reaches the emitted HTML verbatim",
+{
+ css <- "table { background-color:green }"
+ res <- CreateCustomTable(x2, custom.css = css)
+ expect_true(grepl(css, tableHtml(res), fixed = TRUE))
+})
+
+test_that("Default custom.css = '' does not emit a distinctive custom.css token, alongside the iframeless host",
+{
+ res <- CreateCustomTable(x2)
+ expect_true(attr(res, "can-run-in-root-dom"))
+ expect_false(grepl("mytesttoken", tableHtml(res), fixed = TRUE))
+
+ # positive control: the same distinctive token IS present when supplied via custom.css,
+ # so the negative assertion above isn't vacuous
+ resWithCss <- CreateCustomTable(x2, custom.css = "table.mytesttoken { color:red }")
+ expect_true(grepl("mytesttoken", tableHtml(resWithCss), fixed = TRUE))
+})
+
+test_that("override.borders suppresses the border declaration only when both 'border' and 'nth-child' occur in custom.css",
+{
+ # the heuristic (createcustomtable.R) is a plain unanchored substring match on both
+ # tokens; cell.border.width/color are non-default so the declaration is distinctive
+ cssBoth <- "table.mycustom { border: 4px solid rgb(9,9,9); } .mycustom:nth-child(2) { color:red; }"
+ resBoth <- CreateCustomTable(x2, custom.css = cssBoth, cell.border.width = 4, cell.border.color = "red")
+ hBoth <- normWs(tableHtml(resBoth))
+ cellRuleBoth <- regmatches(hBoth, regexpr("\\.celldefault1\\{[^}]*\\}", hBoth))
+ expect_length(cellRuleBoth, 1)
+ expect_false(grepl("border: 4px solid red", cellRuleBoth, fixed = TRUE))
+
+ # "border-top" alone still counts as containing the literal substring "border", but
+ # with no "nth-child" anywhere the heuristic does not trip and the border declaration
+ # is emitted as normal - pinning the literal, unanchored substring match
+ cssBorderOnly <- "table.mycustom { border-top: 4px solid rgb(9,9,9); }"
+ resBorderOnly <- CreateCustomTable(x2, custom.css = cssBorderOnly, cell.border.width = 4, cell.border.color = "red")
+ hBorderOnly <- normWs(tableHtml(resBorderOnly))
+ cellRuleBorderOnly <- regmatches(hBorderOnly, regexpr("\\.celldefault1\\{[^}]*\\}", hBorderOnly))
+ expect_length(cellRuleBorderOnly, 1)
+ expect_true(grepl("border: 4px solid red", cellRuleBorderOnly, fixed = TRUE))
+
+ # "border-top" together with an unrelated selector's "nth-child" DOES trip the
+ # heuristic (it is a plain unanchored substring match on both tokens anywhere in
+ # custom.css, not scoped to the same rule) - this is a deliberate opt-out escape
+ # hatch, not a defect
+ cssUnanchored <- "table.x { border-top: 1px; } .x:nth-child(2){color:red}"
+ resUnanchored <- CreateCustomTable(x2, custom.css = cssUnanchored, cell.border.width = 4, cell.border.color = "red")
+ hUnanchored <- normWs(tableHtml(resUnanchored))
+ cellRuleUnanchored <- regmatches(hUnanchored, regexpr("\\.celldefault1\\{[^}]*\\}", hUnanchored))
+ expect_length(cellRuleUnanchored, 1)
+ expect_false(grepl("border: 4px solid red", cellRuleUnanchored, fixed = TRUE))
+})
+
+test_that("override.borders also suppresses the border declaration in colheaderdefault and rowheaderdefault",
+{
+ cssBoth <- "table.mycustom { border: 4px solid rgb(9,9,9); } .mycustom:nth-child(2) { color:red; }"
+ res <- CreateCustomTable(x2, custom.css = cssBoth, col.header.border.width = 4, col.header.border.color = "red",
+ row.header.border.width = 4, row.header.border.color = "blue")
+ h <- normWs(tableHtml(res))
+
+ colHdrRule <- regmatches(h, regexpr("\\.colheaderdefault1\\{[^}]*\\}", h))
+ expect_length(colHdrRule, 1)
+ expect_false(grepl("border: 4px solid red", colHdrRule, fixed = TRUE))
+
+ rowHdrRule <- regmatches(h, regexpr("\\.rowheaderdefault1\\{[^}]*\\}", h))
+ expect_length(rowHdrRule, 1)
+ expect_false(grepl("border: 4px solid blue", rowHdrRule, fixed = TRUE))
+
+ # positive control: the same border arguments DO reach these rules with no custom.css,
+ # so the negative assertions above are not vacuously true
+ resNoCss <- CreateCustomTable(x2, col.header.border.width = 4, col.header.border.color = "red",
+ row.header.border.width = 4, row.header.border.color = "blue")
+ hNoCss <- normWs(tableHtml(resNoCss))
+ colHdrRuleNoCss <- regmatches(hNoCss, regexpr("\\.colheaderdefault1\\{[^}]*\\}", hNoCss))
+ expect_true(grepl("border: 4px solid red", colHdrRuleNoCss, fixed = TRUE))
+ rowHdrRuleNoCss <- regmatches(hNoCss, regexpr("\\.rowheaderdefault1\\{[^}]*\\}", hNoCss))
+ expect_true(grepl("border: 4px solid blue", rowHdrRuleNoCss, fixed = TRUE))
+})
+
+test_that("Enabling scroll forces the plain Box host even with no custom.css",
+{
+ # row.height sets enable.y.scroll, which alone (custom.css still '') switches the
+ # widget host away from boxIframeless()
+ res <- CreateCustomTable(x2, row.height = "40px")
+ expect_equal(attr(res, "can-run-in-root-dom"), NULL)
+})